Change Format Means Report

 

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
'Begin Description 
'Purpose: This changes the format of Means and SD numbers in Report Pivot Tables (the Tables
'produced by the MEANS procedure).
'Assumptions: The currently designated Output Window contains at least one such Table. 
'This script is called from syntax by using a line such as:
'SCRIPT "path\ChangeFormatMeansReport.SBS" ("n").
' where n is replaced by the required number of decimals.
'Raynald Levesque rlevesque@videotron.ca 2000/10/09
'End description

Option Explicit

Sub main()

' Declare object variables
Dim objOutputDoc As ISpssOutputDoc
Dim objOutputItems As ISpssItems
Dim objOutputItem As ISpssItem
Dim objPivotTable As PivotTable

'Continue the program only if an output document exists.
If objSpssApp.Documents.OutputDocCount > 0 Then
'Get the currently designated output document items collection.
	Set objOutputItems = objSpssApp.GetDesignatedOutputDoc.Items
	Else
	MsgBox "There are no Output window!"
    Exit Sub
End If


Dim intItemCount 	As Integer      	    'number of output items
Dim intItemType 	As Integer  	        'type of item (see SpssType property)
Dim strLabel 		As String 	            'Item label
Dim intIndex 		As Integer
Dim strNbDecimals 	As String
Dim strNewFormat 	As String
strNewFormat="#,###.##"						
' See "String Description of Numeric Formats" in Help Topics:SPSS OLE automation
' for a list of the allowable formats. Eg use $#,###.## of you want dollars. 

'The next line reads the number of decimals passed on by the SCRIPT command.
strNbDecimals = objSpssApp.ScriptParameter(0)

' Iterate through output items
' If type and label match, activate item then call ChangeFormat
	intItemCount = objOutputItems.Count()
	For intIndex = 0 To intItemCount - 1
		Set objOutputItem = objOutputItems.GetItem(intIndex)
		intItemType = objOutputItem.SPSSType()
		strLabel = objOutputItem.Label
' Means 
		If intItemType = SPSSPivot And strLabel = "Report" Then
			Set objPivotTable = objOutputItem.Activate()
			Call ChangeFormat(objPivotTable, strNewFormat,strNbDecimals)
			objOutputItem.Deactivate
		End If
	Next intIndex
End Sub


Sub ChangeFormat(objPivotTable As Object,strNewFormat As String,strNbDecimals As String) 
'Purpose: Change format of Mean and Std. Deviation data cells. 
'Assumptions: The Pivot Table that is to be modified is activated, and strNewFormat is a valid format string
'Effects: Changes the format of the data cells to strNewFormat with strNumberDecimals decimals
'Inputs: PivotTable object that is already activated, new numeric format, number of decimals)
'Return Values: Modified Pivot Table
		
	Dim lngRow 		As Long, lngCol As Long	
	Dim objDataCells As ISpssDataCells
	Dim strTemp 	As String
	Set objDataCells = objPivotTable.DataCellArray
	On Error GoTo errHandler

'Select all relevant data cells.
	With objDataCells
		For lngRow = 0 To .NumRows - 1 
			'Skip lngCol=1 because it is the N column
			For lngCol = 0 To .NumColumns - 1 Step 2
				If Not IsNull (.ValueAt (lngRow, lngCol)) Then
					.SelectCellAt(lngRow, lngCol)
				End If
			Next
		Next
	End With
'Apply new format to selected cells.
	objPivotTable.NumericFormat(strNewFormat,strNbDecimals)
	objPivotTable.Autofit
	
Exit Sub
errHandler:
	Debug.Print "err= ";Err.Number; " Description= ";Err.Description
	Resume Next
End Sub
Related pages

...

Navigate from here