Frequencies footnote | Raynald's SPSS Tools

'Begin Description
'This script takes the statistics for each variable in a Frequencies Statistics Table
' and inserts them as footnotes in the Pivot Tables corresponding to those variables.  
'Requirement: The Frequencies Statistics Table must be selected prior to running the script.
'End Description
'PURPOSE
	'Extracts information from Frequencies Statistics Table, and inserts its contents as footnotes, 
	'into Frequencies Tables
	
'ASSUMPTIONS
	'A Frequencies Statistics Table is selected in the Output Document.
	'The corresponding Frequencies Tables immediately follow
	'Also, the Navigator (Output Document) that contains the Pivot Table is the Designated Output Window
	
'EFFECTS
	'Inserts footnotes into Frequencies Tables that contain the statistics corresponding to those variables
		
'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. 

Public Const TABLENAME As String = "Statistics"
Public Const VALID_ROW As String = "Valid"
Public Const MISSING_ROW As String = "Missing"
Public Const MEAN_ROW As String = "Mean"
Public Const MEDIAN_ROW As String = "Median"
Public Const MODE_ROW As String = "Mode"
Public Const STDEV_ROW As String = "Std. Deviation"
Public Const VARIANCE_ROW As String = "Variance"
Public Const SKEWNESS_ROW As String = "Skewness"
Public Const KURTOSIS_ROW As String = "Kurtosis"
Public Const RANGE_ROW As String = "Range"
Public Const MIN_ROW As String = "Minimum"
Public Const MAX_ROW As String = "Maximum"
Public Const SUM_ROW As String = "Sum"

Public Const cWRONGSELECT As String = "In order for this script to work you must select a Frequencies Statistics table"
Public Const cSELECTMSG As String = "In order for this script to work" & vbCrLf & "you must select a Frequencies Statistics table" & vbCrLf & "that contains one of the following statistics: "
Public Const cSCRIPTNAME As String = "Frequencies Footnote Script"

Option Explicit		'All variables must be declarated before being used
'***********************************************************************
Sub Main
'Variable declarations
	Dim objItem As ISpssItem
	Dim objPivotTable As PivotTable
	Dim bolFoundOutputDoc As Boolean
	Dim bolPivotSelected As Boolean
	
    Call GetFirstSelectedPivot(objPivotTable,objItem, bolFoundOutputDoc, bolPivotSelected)
    
	If bolFoundOutputDoc And bolPivotSelected Then
		'This is the REAL call to extract and then insert Frequencies information
    	Call ExtractFrequenciesFootnote(objPivotTable, objItem)
	End If
	
End Sub
'**********************************************************************
Sub ExtractFrequenciesFootnote(objPivotTable As PivotTable, objItem As ISpssItem)
'Purpose: Extracts statistics from Frequencies Statistic Tables. 
'Assumptions: The Frequencies Statistics Table is already activated
'			  The corresponding Frequencies Tables immediately follow 
'Effects: Extracts the statistics from the Statistics table (after running Frequencies)
'Inputs: Statistics Pivot Table
'Return Values: None

'Declare SPSS-specific objects
    Dim objDataCells As ISpssDataCells
    Dim objColLabels As ISpssLabels
    Dim objRowLabels As ISpssLabels
    Dim objPivMgr As ISpssPivotMgr
    Dim objDimension As ISpssDimension

'Declare various integer indices
    Dim lngRowNum As Long
    Dim lngColNum As Long
    Dim lngNumCols As Long
    Dim lngNumRows As Long
    Dim lngScratchInteger As Long
    Dim lngNumberOfStatistics As Long
    Dim lngStatisticsRow(20) As Long
    Dim lngNumVars As Long
    Dim i As Integer

'Declare strings
    Dim strHoldCells(255,255) As String
    Dim strHoldColLabels(255,255) As String
    Dim strHoldRowLabels(255,255) As String
    Dim strStatisticsLabel(20) As String
    Dim strFootNoteStrings(255) As String    
	Dim strStatistics As String
	
'Declare boolean variables
	Dim bolFoundStatistic As Boolean
	 
'Instantiate SPSS objects
    Set objDataCells = objPivotTable.DataCellArray()
    Set objColLabels = objPivotTable.ColumnLabelArray()
    Set objRowLabels = objPivotTable.RowLabelArray()

	'Initialize lngStatisticsRow
	lngNumberOfStatistics = 13
	For lngScratchInteger = 1 To lngNumberOfStatistics
	    lngStatisticsRow(lngScratchInteger) = 999
	Next lngScratchInteger
	
	'Initialize strStatisticsLabel
	'Commenting out & reassigning indices control which statistics
	'are used, and the order in which they are printed
	strStatisticsLabel(1) = VALID_ROW
	strStatisticsLabel(2) = MISSING_ROW
	strStatisticsLabel(3) = MEAN_ROW
	strStatisticsLabel(4) = MEDIAN_ROW
	strStatisticsLabel(5) = MODE_ROW
	strStatisticsLabel(6) = STDEV_ROW
	strStatisticsLabel(7) = VARIANCE_ROW
	strStatisticsLabel(8) = SKEWNESS_ROW
	strStatisticsLabel(9) = KURTOSIS_ROW
	strStatisticsLabel(10) = RANGE_ROW
	strStatisticsLabel(11) = MIN_ROW
	strStatisticsLabel(12) = MAX_ROW
	strStatisticsLabel(13) = SUM_ROW
	
	'Check to see if the correct table is selected -- must have Statistics as title
	If objPivotTable.TitleText <> TABLENAME Then
	    MsgBox cWRONGSELECT ,vbOkOnly, cSCRIPTNAME
	    objItem.Deactivate
	    Exit Sub
	End If
		
	lngNumCols = objRowLabels.NumColumns
	lngNumRows = objRowLabels.NumRows
	
	'Extracting row labels       
	For lngRowNum = 0 To lngNumRows - 1
	    For lngColNum = 0 To lngNumCols - 1   
	       If objRowLabels.ValueAt(lngRowNum,lngColNum) <> "" Then   
	           strHoldRowLabels(lngRowNum+1,lngColNum+1) = objRowLabels.ValueAt(lngRowNum,lngColNum)     
	       Else
	           strHoldRowLabels(lngRowNum+1,lngColNum+1) = "."
	       End If
	    Next lngColNum
	Next lngRowNum

	bolFoundStatistic = False

	'Examine all row labels (strHoldRowLabels)
	'The first occurence of a key word (strStatisticsLabel) indicates the statistic
	'Set the statistic column variable (lngStatisticsRow)
	For lngRowNum = 0 To lngNumRows - 1
	    For lngColNum = 0 To lngNumCols - 1
	        For lngScratchInteger = 1 To lngNumberOfStatistics
	            If lngStatisticsRow(lngScratchInteger) = 999 Then
	                If strHoldRowLabels(lngRowNum+1,lngColNum+1) = strStatisticsLabel(lngScratchInteger) Then
	                    lngStatisticsRow(lngScratchInteger) = lngRowNum
	                    bolFoundStatistic = True
	                End If
	            End If
	        Next lngScratchInteger
	    Next lngColNum
	Next lngRowNum

	If bolFoundStatistic = False Then	'Didn't find any of Statistics in the column labels, probably selected wrong table
		For i = 1 To lngNumberOfStatistics
			strStatistics = strStatistics & "- " & strStatisticsLabel(i) & vbCrLf
		Next i
	    MsgBox cSELECTMSG & vbCrLf & vbCrLf & strStatistics,vbOkOnly, cSCRIPTNAME
	    objItem.Deactivate
	    Exit Sub
	End If
	
	Set objPivMgr = objPivotTable.PivotManager
	If objPivMgr.NumLayerDimensions = 0 Then	'variables appear in the columns
		lngNumCols = objColLabels.NumColumns
		lngNumRows = objColLabels.NumRows
		 
		'Extracting column labels       
		For lngRowNum = 0 To lngNumRows - 1
		    For lngColNum = 0 To lngNumCols - 1   
		       If objColLabels.ValueAt(lngRowNum,lngColNum)<>"" Then   
		           strHoldColLabels(lngRowNum+1,lngColNum+1) = objColLabels.ValueAt(lngRowNum,lngColNum)     
		       Else
		           strHoldColLabels(lngRowNum+1,lngColNum+1) = "."
		       End If
		    Next lngColNum
		Next lngRowNum
		lngNumVars = lngNumCols
	Else	'variables appear in the layer
		Set objDimension = objPivMgr.LayerDimension(0)
		lngNumCols = objDimension.NumCategories
		
		'Extract variable names
		For lngColNum = 0 To lngNumCols - 1
			objDimension.CurrentCategory = lngColNum
			strHoldColLabels(2, lngColNum+1) = objDimension.CategoryValueAt(lngColNum)
		Next lngColNum
		lngNumVars = lngNumCols
	End If
	        
	lngNumCols = objDataCells.NumColumns
	lngNumRows = objDataCells.NumRows
	  
	'Extracting cell values (the statistics)
	'  and creating (concatenating) the footnote strings       
	For lngColNum = 0 To lngNumCols - 1
		For lngRowNum = 0 To lngNumRows - 1    
	        If objDataCells.ValueAt(lngRowNum,lngColNum)<>"" Then   
	            strHoldCells(lngRowNum+1,lngColNum+1) = objDataCells.ValueAt(lngRowNum,lngColNum)
	        Else
	            strHoldCells(lngRowNum+1,lngColNum+1) = "."
	        End If
	        If strHoldCells(lngRowNum+1,lngColNum+1) <> "." Then
	            For lngScratchInteger = 1 To lngNumberOfStatistics
	                If lngRowNum = lngStatisticsRow(lngScratchInteger) Then
	                    If InStr(strHoldCells(lngRowNum+1,lngColNum+1), ".") Then
	                    	strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + Format(strHoldCells(lngRowNum+1,lngColNum+1),"###.##") + "  "
	                    Else
	                    	strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + strHoldCells(lngRowNum+1,lngColNum+1) + "  "
	                    End If
	                End If
	            Next lngScratchInteger
	        End If
	    Next lngRowNum
	Next lngColNum
	
	objItem.Deactivate
		    
	'InsertFootnotes inserts the extracted statistics into a footnote for each of the 
	'variables' corresponding table.
	Call InsertFootnotes(lngNumVars, strFootNoteStrings(), strHoldColLabels())

End Sub

'*******************************************************************

Sub InsertFootnotes(lngNumVars As Long, strFootNotes() As String, strHoldColLabels() As String)
'Purpose: Inserts statistics, as footnotes, into Frequencies Tables.
'Assumptions: The statistics for each of the frequencies table have been extracted by ExtractFrequenciesFootnote
'Effects: Inserts footnotes into Frequencies Tables
'Inputs: Number of Variables (lngNumVars), Footnotes to insert(strFootNotes), Variable names(strHoldRowLabels)
'Return Values: None

	Dim objOutputDoc As ISpssOutputDoc
	Dim objItems As ISpssItems
	Dim objItem As ISpssItem
	Dim objPivotTable As PivotTable
	
	Dim lngStartIndex As Long
	Dim lngIndex As Long
	Dim lngAddItems As Long
	Dim i As Long
	
	'Instantiate the higher level objects
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Set objItems = objOutputDoc.Items
	
	For i = 0 To objItems.Count()
		Set objItem = objItems.GetItem(i)
		If objItem.Selected = True Then
			lngStartIndex = i
			Exit For
		End If
	Next i	
	'Search through all Output Document Items
	'If title matches the variable's name, insert the footnote
	lngAddItems = 0 
	If lngNumVars <> 1 Then 
		lngAddItems = 3
	Else
		lngAddItems = 1
	End If
	lngStartIndex = lngStartIndex + lngAddItems
	For i = lngStartIndex To lngStartIndex + lngNumVars - 1
	    Set objItem = objItems.GetItem(i)
	    If objItem.SPSSType = SPSSPivot Then
	        Set objPivotTable = objItem.Activate
	        objPivotTable.SelectTitle
	        For lngIndex = 0 To lngNumVars-1
	            If strHoldColLabels(2, lngIndex+1) = objPivotTable.TitleText Then
	                objPivotTable.InsertFootnote(strFootNotes(lngIndex))
	            End If
	        Next lngIndex
	        objItem.Deactivate
	    End If		
	Next i

End Sub
...
Navigate from here