Make Totals Bold All Pivot Tables

 

Download as .sbs Shows as plain text

 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
'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
Related pages

...

Navigate from here