Highlights significant cells of all ANOVA tables in Designated Viewer

' Highlight significant cells of all ANOVA tables in the Designated Viewer.
' Writen for Manfred Straehle by Raynald Levesque on 2004/01/30.

Sub Main
	Dim objPivot As PivotTable
	Dim objItem As ISpssItem
	Dim strLabel As String
	strLabel="ANOVA"
	Do While GetNextPivot(objPivot, objItem, strLabel)
		Call Highlight(objPivot, objItem)
	Loop
End Sub

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

Const TextTotalStr ="Sig."
Const cGREEN = RGB(60, 179, 113)
Const cWHITE = RGB(255,255,255)

Sub Highlight(objPivotTable As PivotTable , objItem As ISpssItem)

	Dim strSigVal As String         		' A navigator item.
		Dim bolPivotSelected As Boolean
		Dim s_bolCellsSelected As Boolean

		'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

Function GetNextPivot(	objPivot As PivotTable, _
	objItem As ISpssItem, _
	strLabel As String ) 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


	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 And InStr(objItem.Label,strLabel)>0 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