'Begin Description 'This script takes the selected table and changes the labels and data cells 'to bold And blue if the Row, or Column Labels contain the word "Total". 'Requirement: A Pivot Table must be selected. 'End Description 'THIS SCRIPT WAS CREATED FROM THE STARTER SCRIPT 'Reformat by Labels'(REFORMLB.sbs) 'PURPOSE 'This script takes the selected table in the Navigator and changes the labels and data cells 'To bold And blue if the Row, Column, Or Layer Labels are the word "Total" 'ASSUMPTIONS 'A pivot table that contains "Total" in row, column, or layer labels is selected in the Navigator. 'Also, the Navigator (Output Document) that contains the Pivot Table is the Designated Output Window 'EFFECTS 'Changes the labels and associated data cells to bold and blue 'HINTS 'If you are new to programming, select Scripting Tips from the 'Help menu for a basic introduction. 'For information on SPSS automation objects, properties and methods, 'press F2 to display the Object Browser. 'For context-sensitive help on Sax Basic terms as well as SPSS objects, 'properties, and methods, press F1. Option Explicit 'All variables must be declarated before being used 'string constants Const cTOTAL As String = "Total" 'constants for what to reformat Public Const LABELS_ONLY As Integer = 0 Public Const DATA_ONLY As Integer = 1 Public Const LABELS_AND_DATA As Integer = 2 'constants for type of search for labels Public Const EXACT_MATCH As Integer = 0 Public Const PARTIAL_MATCH As Integer = 1 Public bolCellsSelected As Boolean Sub Main ' Declare object variables used in this procedure. Dim objItem As ISpssItem ' A navigator item. Dim objPivotTable As PivotTable ' Pivot table. ' Declare variables used for your specific task Dim strTargetText As String ' Text for locating target label(s) Dim intTargetType As Integer ' Type of cells (column, row, data, etc.) Dim intTargetFormat As Integer ' How to format Dim bolFoundOutputDoc As Boolean Dim bolPivotSelected As Boolean Dim intSearchType As Integer bolCellsSelected = False ' Specify what you want to format: ' ********************************************************** ' Replace "Total" with your column or row or layer label text. ' You must specify the text exactly as the label in the pivot table, ' including spaces. Keep the quotation marks as they are. ' ********************************************************** strTargetText = cTOTAL 'If you want the label to exactly match strTargetText, remove the ' from the next line 'intSearchType = EXACT_MATCH 'If you the label only needs to partially match strTargetText, remove the ' from the next line intSearchType = PARTIAL_MATCH 'Call GetSelectedTable to get the selected pivot table Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected) If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then 'either there wasn't an output doc or a pivot table wasn't selected Exit Sub End If '************************************************************************* 'The next section selects the cells that are to be reformatted. 'You can select what you want to reformat by changing the second argument 'in the SelectRowLabelsByText and SelectColLabelsByText subroutines. 'If you only want to reformat the labels, change the second parameter to LABELS_ONLY 'If you only want to reformat the data cells, change the second parameter to DATA_ONLY 'If you want to reformat the labels and data, change the second parameter to LABELS_AND_DATA 'If you want to reformat the rows, remove the ' in front of the next line Call SelectRowLabelsByText(strTargetText, LABELS_AND_DATA, intSearchType, objPivotTable) 'If you want to reformat the columns, remove the ' in front of the next line Call SelectColLabelsByText(strTargetText, LABELS_AND_DATA, intSearchType, objPivotTable) '************************************************************************* If bolCellsSelected = True Then 'The next section formats the selected labels and/or data With objPivotTable 'Remove the ' on the next line if you want to hide the selected cells '.TextHidden = True 'The next four lines deal with text style. 'Remove the ' on the line that corresponds to the text style you want to apply '.TextStyle = 0 'Normal text '.TextStyle = 1 'Italic text .TextStyle = 2 'Bold text '.TextStyle = 3 'Bold Italic text 'Remove the ' on the following line if you want Underlined text '.TextUnderlined = true 'The next six lines deal with text color. 'Remove the ' on the line that corresponds to the color you want to apply '.TextColor = RGB(255, 0, 0) 'Red .TextColor = RGB(0, 0, 255) 'Blue '.TextColor = RGB(0, 255, 0) 'Green '.TextColor = RGB(255, 255, 0) 'Yellow '.TextColor = RGB(0, 0, 0) 'Black '.TextColor = RGB(255, 255, 255)'White 'The next six lines deal with the backround color of the selected cells 'Remove the ' on the line that corresponds to the color you want to apply '.BackgroundColor = RGB(255, 0, 0) 'Red '.BackgroundColor = RGB(0, 0, 255) 'Blue '.BackgroundColor = RGB(0, 255, 0) 'Green '.BackgroundColor = RGB(255, 255, 0) 'Yellow '.BackgroundColor = RGB(0, 0, 0) 'Black '.BackgroundColor = RGB(255, 255, 255) 'White 'The next line deals with the size of the text in the selected cells. 'Remove the ' to change the text size. Enter a different value after = to modify the size '.TextSize = 10 'Specify the font size in points 'The next 4 lines deal with the margins around the text in the selected cells. 'Remove the ' to change the margin. Enter a different value after = to modify the margin '.TopMargin = 2 'Specify top margin in points '.BottomMargin = 2 'Specify bottom margin in points '.LeftMargin = 2 'Specify left margin in points '.RightMargin = 2 'Specify right margin in points 'The next 2 lines deal with the alignment of text within the selected cells. 'Remove the ' to change the alignment. Enter a different value after = to change the type of alignment '.HAlign = 2 '0=left, 1=right, 2=center '.VAlign = 2 '0=top, 1=bottom, 2=center End With End If ' Deactivate the pivot table and exit objItem.Deactivate End Sub Sub SelectRowLabelsByText (strText As String, intType As Integer, intCriteria As Integer, objPivotTable As PivotTable) Dim objRowLabels As ISpssLabels ' Row Label array. Dim intCol As Integer ' Number of columns in label array. Dim intRow As Integer ' Number of rows in label array Dim intR As Integer ' Loop Counter Dim intC As Integer ' Loop Counter 'Get row labels with or without data as targeted ' Get the targeted row labels Set objRowLabels = objPivotTable.RowLabelArray ' RowLabelArray is a 2-dimensional array. Loop through the cells to ' find the label text that matches the target text (strText) intCol = objRowLabels.NumColumns intRow = objRowLabels.NumRows For intC = 0 To intCol - 1 For intR = 0 To intRow - 1 If (objRowLabels.ValueAt(intR,intC) = strText And intCriteria = EXACT_MATCH) _ Or (InStr(objRowLabels.ValueAt(intR,intC), strText) And intCriteria = PARTIAL_MATCH)Then If intType = LABELS_ONLY Then 'Target labels only objRowLabels.SelectLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = DATA_ONLY Then 'Target data only objRowLabels.SelectDataUnderLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = LABELS_AND_DATA Then objRowLabels.SelectLabelDataAt(intR, intC) bolCellsSelected = True End If End If Next intR Next intC End Sub Sub SelectColLabelsByText (strText As String, intType As Integer, intCriteria As Integer, objPivotTable As PivotTable) Dim objColumnLabels As ISpssLabels ' Column label arrays Dim intCol As Integer ' Number of columns in label array. Dim intRow As Integer ' Number of rows in label array Dim intR As Integer ' Loop Counter Dim intC As Integer ' Loop Counter 'Column Labels targeted ' Get the targeted column labels Set objColumnLabels = objPivotTable.ColumnLabelArray ' ColumnLabelArray is a 2-dimensional array. Loop through the cells to ' find the label text that matches the target text (strText) intCol = objColumnLabels.NumColumns intRow = objColumnLabels.NumRows For intC = 0 To intCol - 1 For intR = 0 To intRow - 1 If (objColumnLabels.ValueAt(intR,intC) = strText And intCriteria = EXACT_MATCH) _ Or (InStr(objColumnLabels.ValueAt(intR,intC), strText) And intCriteria = PARTIAL_MATCH)Then If intType = LABELS_ONLY Then 'Target labels only objColumnLabels.SelectLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = DATA_ONLY Then 'Target data only objColumnLabels.SelectDataUnderLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = LABELS_AND_DATA Then objColumnLabels.SelectLabelDataAt(intR, intC) bolCellsSelected = True End If End If Next intR Next intC End Sub