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
'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