Изменить формат выдачи процедуры Means

'Begin Description 
'Назначение: скрипт изменяет формат средних значений и стандартных отклонений в мобильных таблицах Report
'(создаваемых процедурой MEANS).
'Условия: назначенное окно выдачи содержит, по крайней мере, одну такую таблицу.
'Скрипт вызывается из синтаксиса с использованием строки вида
'SCRIPT "path\\ChangeFormatMeansReport.SBS" ("n").
' (где n следует заменить желаемым количеством десятичных знаков).
'Автор: Raynald Levesque, rlevesque@videotron.ca, 09.10.2000
'End description

'Размещение: http://www.spsstools.ru/Scripts/PivotTables/ChangeFormatMeansReportSbs.txt (.sbs).
'Перевод: А. Балабанов, 26.12.2008.
'Проверено: SPSS 15.0.0.
Option Explicit

Sub main()

' Объявление объектных переменных
Dim objOutputDoc As ISpssOutputDoc
Dim objOutputItems As ISpssItems
Dim objOutputItem As ISpssItem
Dim objPivotTable As PivotTable

'Продолжаем программу лишь при наличии открытого документа выдачи.
If objSpssApp.Documents.OutputDocCount > 0 Then
'устанавливаем ссылку на объекты назначенного (Designated) окна выдачи.
	Set objOutputItems = objSpssApp.GetDesignatedOutputDoc.Items
	Else
	MsgBox "Не обнаружено окна результатов!"
    Exit Sub
End If


Dim intItemCount 	As Integer      	    'число элементов в окне выдачи
Dim intItemType 	As Integer  	        'тип элемента (константа свойства SpssType)
Dim strLabel 		As String 	            'метка элемента
Dim intIndex 		As Integer
Dim strNbDecimals 	As String
Dim strNewFormat 	As String
strNewFormat="#.#"
' См. раздел "String Description of Numeric Formats" в справке по SPSS OLE Automation,
' там найдёте перечень возможных числовых форматов. Например, можно использовать $#,###.##, если надо отображать значок доллара.

'Следующая строка считывает число десятичных знаков, переданных при вызове скрипта в команде SCRIPT.
strNbDecimals = objSpssApp.ScriptParameter(0)

' Пробежка по элементам окна выдачи
' Если тип и метка элемента совпадают с искомыми, активируем элемент, после чего меняем формат (процедура ChangeFormat).
	intItemCount = objOutputItems.Count()
	For intIndex = 0 To intItemCount - 1
		Set objOutputItem = objOutputItems.GetItem(intIndex)
		intItemType = objOutputItem.SPSSType()
		strLabel = objOutputItem.Label
' Метка "Report" соответствует таблице, возвращаемой процедурой 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) 
'Назначение: изменение формата у ячеек данных со средними значениями и стандартными отклонениями.
'Условия: активирована нужная мобильная таблица, strNewFormat является строкой с корректным форматом
'Действия: устанавливает формат ячеек данных, соответствующей значению из strNewFormat с strNumberDecimals десятичными знаками
'Входные значения: активированная мобильная таблица как объект, новый числовой формат, число десятичных знаков)
'Выходные значения: изменённая мобильная таблица
		
	Dim lngRow 		As Long, lngCol As Long	
	Dim objDataCells As ISpssDataCells
	Dim strTemp 	As String
	Set objDataCells = objPivotTable.DataCellArray
	On Error GoTo errHandler

'Выделяем все нужные ячейки данных.
	With objDataCells
		For lngRow = 0 To .NumRows - 1 
			'пропускаем столбец с номером lngCol=1, т.к. это столбец с N - объёмами выборок
			For lngCol = 0 To .NumColumns - 1 Step 2
				If Not IsNull (.ValueAt (lngRow, lngCol)) Then
					.SelectCellAt(lngRow, lngCol)
				End If
			Next
		Next
	End With
'Применяем новый формат к выделенным ячейкам.
	objPivotTable.NumericFormat(strNewFormat,strNbDecimals)
	objPivotTable.Autofit
	
Exit Sub
errHandler:
	Debug.Print "Ошибка: ";Err.Number; " Описание: ";Err.Description
	Resume Next
End Sub