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
'#Language "WWB-COM"
'Begin Description
'To color the significant cells of an Independent Samples Test.
'All cells with values <= cSigVal will be colored In green.
'Requirements: The pivot table on which the script will be run should be selected.
'If reequired, use a different "Significant Value" in the line between the ######### below.
'End Description

'rlevesque@videotron.ca 2001/05/29
'Visit my SPSS site at http://spsstools.net/

Option Explicit

' HEY, HEY, HEY!!!
' In SPSS 16.0 or later check if the path in the #Uses comment below is correct. It is critical to make
' global procedures like GetFirstSelectedPivot work!

'#Uses "C:\Program Files\IBM\SPSS\Statistics\23\Samples\Global.wwd"

'##################
Const cSigVal=.005
'##################

Const TextTotalStr ="2-tailed"
Const cGREEN = RGB(60, 179, 113)
Const cWHITE = RGB(255,255,255)

Sub Main

	Dim strSigVal As String
		Dim objItem As ISpssItem          		' A navigator item.
		Dim objPivotTable As PivotTable         ' Pivot table.
		Dim bolFoundOutputDoc As Boolean
		Dim bolPivotSelected As Boolean
		Dim s_bolCellsSelected As Boolean

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

		'global variable that keeps track of whether any cells are selected from searching
		s_bolCellsSelected = False

		Dim objDataCells As ISpssDataCells
		Dim lngNumRows As Long
		Dim lngNumColumns As Long
		Set objDataCells = objPivotTable.DataCellArray
		' Loop through the cells and shades those cells with values less than cSigVal:

		Dim objRowLabels As ISpssLabels         ' Row Label array.
		Set objRowLabels = objPivotTable.RowLabelArray
		Dim objColLabels As ISpssLabels         ' Col Label array.
		Set objColLabels = objPivotTable.ColumnLabelArray
		lngNumRows = objDataCells.NumRows
		lngNumColumns = objDataCells.NumColumns
		Dim I As Integer, J As Integer
		objItem.Deactivate
		For I = 0 To lngNumRows -1
			Dim dummy As Integer
				For J = 0 To lngNumColumns -1
					If InStr (objColLabels.ValueAt(objColLabels.NumRows-1,J), TextTotalStr)> 0 Then
						If Len(objDataCells.ValueAt (I,J)) > 0 Then
							If objDataCells.ValueAt (I,J) <= cSigVal Then
								objDataCells.BackgroundColorAt (I,J) = cGREEN
							Else
								objDataCells.BackgroundColorAt  (I,J) = cWHITE
							End If
						Else
							objDataCells.BackgroundColorAt  (I,J) = cWHITE
						End If
					End If
				Next
		Next
		' Deactivate the pivot table and exit
		objItem.Activate
		objItem.Deactivate
End Sub