'MakeTotalsBoldAllPivotTables.SBS 'This is a modification of MakeTotalsBold.SBS 'Begin Description 'This script takes all visible Pivot Tables and changes the labels and data cells 'to bold and blue if the Row, or Column Labels contain the word "Total". 'Requirement: At least one visible Pivot Table must be present. 'End Description 'THIS SCRIPT WAS CREATED FROM THE STARTER SCRIPT 'Reformat by Labels'(REFORMLB.sbs) 'Modified by Raynald Levesque on 2004/11/14 to apply to all visible PT instead of 'to the currently selected PT 'PURPOSE 'This script takes ALL visible 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 'Designated Output Window contains at least one Pivot Table with "Total" in row, column, or layer labels. '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() Dim objPivot As PivotTable Dim objItem As ISpssItem Do While GetNextPivot(objPivot, objItem) If objItem.Visible = vbTrue Then 'Modify only visible Pivot Tables Call MakeTotalsBold(objPivot, objItem) End If objItem.Deactivate Loop End Sub Sub MakeTotalsBold(objPivotTable As PivotTable, objItem As ISpssItem ) ' Declare variables used for your specific task Dim strTargetText As String ' Text for locating target label(s) 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 '************************************************************************* '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) 'This Function was written by SPSS 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) 'This Function was written by SPSS 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 Function GetNextPivot(objPivot As PivotTable, objItem As ISpssItem) As Boolean 'Purpose: Find each Pivot Table in turn 'Assumptions: A Pivot Table is in the Output Doc (Navigator); output doesn't change between calls 'Effects: each time the procedure is called, it activates the next selected Pivot Table 'Inputs: PivotTable object, Item object that contains selected PivotTable 'Return Values: activated PivotTable, Item in the Navigator, function value is True if a pivot table is found 'This Function was written by SPSS Static objDocuments As ISpssDocuments ' SPSS documents. Static objOutputDoc As ISpssOutputDoc ' Output document Static objItems As ISpssItems ' Output Navigator items Static intItem As Integer ' Output Navigator item's index Static intItemCount As Integer ' total number of items in the navigator Dim intItemType As Integer Dim bolSelected As Boolean ' True if an item is selected. Dim bolReset As Boolean Dim i As Integer ' initialize the return values GetNextPivot = False Set objPivot = Nothing Set objItem = Nothing ' if this is the first call, set a flag to initialize things If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then bolReset = True End If If bolReset Then 'Get list of documents in SPSS. Set objDocuments = objSpssApp.Documents End If ' done with the document collection If bolReset Then ' Get designated document only if there is at least one output document. If objDocuments.OutputDocCount > 0 Then 'Get the currently designated output document. Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Else 'If no navigator window exists. MsgBox( "No navigator document found." ) Exit Function End If End If ' done with outputdoc ' Get the outline tree and the number of items: If bolReset Then Set objItems = objOutputDoc.Items intItemCount = objItems.Count End If ' there will be problems if anything failed, just make sure If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then Debug.Print "objDocuments Is Nothing: " & (objDocuments Is Nothing) Debug.Print "objOutputDocIs Nothing: " & (objOutputDoc Is Nothing) Debug.Print "objItems Is Nothing: " & (objItems Is Nothing) MsgBox "There was a problem with the Navigator document.", vbExclamation, "GetNextPivot" Exit Function End If ' a simple check that output hasn't changed If intItemCount <> objItems.Count Then MsgBox "Output changed while Script was running.", vbExclamation, "GetNextPivot" Exit Function End If If bolReset Then intItem = 0 End If ' Get the next pivot table. For i = intItem To intItemCount - 1 Set objItem = objItems.GetItem(i) intItemType = objItem.SPSSType If intItemType = SPSSPivot Then intItem = i + 1 ' start here next time Set objPivot = objItem.ActivateTable() 'Activate the pivot table. GetNextPivot = True ' We did find a pivot table. Exit For ' Exit the loop. End If Next i If GetNextPivot = False And intItem = 0 Then 'No pivot table was found. MsgBox( "There are no Pivot Tables in the output." ) Exit Function End If End Function