'Begin Description
'Обеспечивает курсивное начертание процентным показателям во всех мобильных таблицах. Другие варианты начертания
'можно задать с помощью 4 констант, определённых ниже.
'Скрипт также можно использовать для замены фона соответствующих ячеек
'Размещено в SPSSX-L, автор: Raynald Levesque, 13.11.2004.
'End Description

'Размещение: http://www.spsstools.ru/Scripts/PivotTables/ItalizePercentagesInPivotTables.txt (.sbs).
'Перевод: А. Балабанов, 02.01.2009. ###внесённые изменения связаны с неустойчивой работой скрипта в таблицах с пустыми ячейками - А.Б.
'Проверено: SPSS 15.0.1.1.

Option Explicit

'Одна из следующих констант может быть использована вами в строке "Call ChangeTextStyle()" ниже
Const cNORMAL=0
Const cITALIC=1
Const cBOLD=2
Const cBOLDITALIC=3
Dim bolUpdated As Boolean '###добавлено - А.Б.
Option Explicit

Sub Main
	Dim objPivot As PivotTable
	Dim objItem As ISpssItem
	
	Do While GetNextPivot(objPivot, objItem)
		'запрет обновления экрана до завершения работы
		objPivot.UpdateScreen = False
		Call ChangeTextStyle(objPivot, "%", cITALIC, vbWhite)
		'Call ChangeTextStyle(objPivot, "%", cNORMAL, vbYellow) - в таком вариенте будет замена фона на жёлтый  - А.Б.
		objPivot.UpdateScreen = True
	If bolUpdated Then '###добавлено (не делаем автоподгонку таблиц, которые не изменяли) - А.Б.
		objPivot.Autofit
		objItem.Deactivate
		objItem.ActivateTable 'гарантируем полное обновление таблицы
	End If '###добавлено - А.Б.
		objItem.Deactivate
	Loop
End Sub

Sub ChangeTextStyle(objPivot As PivotTable, strNeedle As String , intTextStyle As Integer, lngBackColor As Long)
	Dim lngRow As Long, lngCol As Long
	Dim objDataCells As ISpssDataCells
	Dim strFormat As String
bolUpdated=False
	Set objDataCells = objPivot.DataCellArray
		With objDataCells
			For lngRow = 0 To .NumRows - 1
				For lngCol = 0 To .NumColumns - 1

				If Not IsNull (.ValueAt (lngRow, lngCol)) Then '### изменено (сначала проверим, не пуста ли ячейка, а затем - получим её формат) - А.Б.
					strFormat = .NumericFormatAt(lngRow,lngCol) '### изменено - А.Б.
					If InStr(strFormat,strNeedle)>0 Then '### изменено - А.Б.
						.TextStyleAt(lngRow,lngCol)= intTextStyle
						.BackgroundColorAt(lngRow,lngCol)= lngBackColor
						bolUpdated=True '###добавлено - А.Б.
					End If '### изменено - А.Б.
				End If
				Next
			Next
		End With
	'objPivot.Autofit ###удалено - А.Б.
End Sub


Function GetNextPivot(objPivot As PivotTable, objItem As ISpssItem) As Boolean
'Назначение: нахождение следующей мобильной таблицы
'Условия: в окне Навигатора находятся таблицы; окно не меняет своего содержимого между вызовами функции
'Действия: каждый раз при вызове функции она выделяет и активирует следующую мобильную таблицу
'Входные значения: объект PivotTable (мобильная таблица), объект Item - контейнер выделенной мобильной таблицы
'Выходные значения: активированная мобильная таблица, указание на выделенный элемент, функция возвращает значение "истина", если мобильная таблица найдена
'Программный код этой процедуры составлен SPSS

'Заметьте, что функция содержит статические переменные, что позволяет осуществлять контроль перебора таблиц в окне результатов
'непосредственно в самой функции (информация о текущем положении курсора не теряется между вызовами функции).
'Кроме того, функция не только возвращает в процедуру Main своё "основное" значение (Истина/Ложь), но и переопределяет значения
'переменных objPivot и objItem, которые далее используются процедурой Main.
'При первом вызове статические переменные ещё не определены; функция контролирует это и определяет их, если требуется - примеч. перев.

	Static objDocuments As ISpssDocuments  	' коллекция документов SPSS
	Static objOutputDoc As ISpssOutputDoc   ' документ выдачи (результатов, Output)
	Static objItems As ISpssItems       	' коллекция объектов окна выдачи (Output Navigator)
	Static intItem As Integer 		   		' индекс объекта окна Output Navigator
	Static intItemCount As Integer			' общее число объектов в окне выдачи
	
	Dim intItemType As Integer
	Dim bolSelected As Boolean             	' истина, если объект выделен
	Dim bolReset As Boolean
	Dim i As Integer

	' инициализация выходных значений
	GetNextPivot = False
	Set objPivot = Nothing
	Set objItem = Nothing
		
	' если это первый вызов, установим флаг, сигнализирующий о необходимости инициализации ряда переменных
	If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then
		bolReset = True
	End If
		
	If bolReset Then
		'получим перечень документов в SPSS.
		Set objDocuments = objSpssApp.Documents
	End If	' закончена обработка перечня документов
	
	If bolReset Then
		' Получаем ссылку на документ результатов только если есть хотя бы один такой документ
		If objDocuments.OutputDocCount > 0 Then
		   'Ссылка на назначенное окно результатов
		   Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
		Else
			'если нет окон результатов
			MsgBox( "Не найдено окна результатов!" )
			Exit Function
		End If
	End If	' закончили с документом результатов
	
	' Ссылка на дерево элементов и подсчёт их числа
	If bolReset Then
		Set objItems = objOutputDoc.Items
		intItemCount = objItems.Count
	End If
	
	' чтобы не создать проблем, если что-то не так, контролируем, что нужные переменные определены
	If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then
		Debug.Print "Переменная objDocuments не определена (Nothing): " & (objDocuments Is Nothing)
		Debug.Print "Переменная objOutputDoc не определена (Nothing): " & (objOutputDoc Is Nothing)
		Debug.Print "Переменная objItems не определена (Nothing): " & (objItems Is Nothing)
		MsgBox "Произошли ошибки при работе с документом результатов.", vbExclamation, "Функция GetNextPivot"
		Exit Function
	End If
	
	' контроль того, что документ не изменился между вызовами (на основе подсчёта числа элементов)
	If intItemCount <> objItems.Count Then
		MsgBox "Содержимое окна результатов неожиданно изменилось во время выполнения скрипта.", vbExclamation, "Функция GetNextPivot"
		Exit Function
	End If
	
	If bolReset Then
		intItem = 0
	End If
	
	' Активация следующей мобильной таблицы
	For i = intItem To intItemCount - 1
		Set objItem = objItems.GetItem(i)
		intItemType = objItem.SPSSType
		If intItemType = SPSSPivot Then 
			intItem = i + 1								' запоминаем состояние счётчика цикла
			Set objPivot = objItem.ActivateTable()  	' активация мобильной таблицы
			GetNextPivot  = True	                  	' таблица найдена
			Exit For                                  	' выход из цикла
        End If
	Next i
	
	If GetNextPivot = False And intItem = 0 Then
		'не было обнаружено мобильных таблиц
		MsgBox( "В окне результатов не обнаружено мобильных таблиц." )
		Exit Function
	End If

End Function