Выключка заголовков мобильных таблиц влево/вправо/по центру

 

Загрузить как .sbs Показать простым текстом

 

  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
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Option Explicit
' Определим 3 константы для 3 режимов выравнивания
Const SpssHAlLeft=0  'Горизонтальная выключка влево
Const SpssHAlRight=1 'Горизонтальная выключка вправо
Const SpssHAlCenter=2 'Горизонтальная выключка по центру

Sub Main
'Выравнивание заголовков во всех мобильных таблицах в назначенном окне результатов
'Автор: rlevesque@videotron.ca, 24.01.2002
'http://www.spsstools.ru

' Перевод: А. Балабанов, 11.01.2009.
' Проверено: SPSS 15.0.0.
' Размещение: http://www.spsstools.ru/Scripts/PivotTables/LeftRightOrCenterJustifyTitleOfAllPivotTables.txt (.sbs).
	Dim objPivot As PivotTable
	Dim objItem As ISpssItem
	
	Do While GetNextPivot(objPivot, objItem)
		objPivot.SelectTitle
'		при необходимости используйте другую константу, определяющую выравнивание
		objPivot.HAlign=SpssHAlLeft
		objItem.Deactivate
	Loop
End Sub

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


	Static objDocuments As ISpssDocuments  	' коллекция документов SPSS
	Static objOutputDoc As ISpssOutputDoc   ' документ выдачи (результатов, Output)
	Static objItems As ISpssItems       	' коллекция объектов в окне выдачи
	Static intItem As Integer 		   		' индекс очередного объекта
	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( "Не найдено окна с результатами (Output Navigator)!" )
			Exit Function
		End If
	End If	' закончена обработка переменной с документом Output

	' Установление ссылки на дерево объектов и подсчёт количества объектов в окне результатов:
	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: " & (objDocuments Is Nothing)
		Debug.Print "Пустая ссылка objOutputDoc: " & (objOutputDoc Is Nothing)
		Debug.Print "Пустая ссылка objItems: " & (objItems Is Nothing)
		MsgBox "Случились проблемы при инициализации переменных окна навигатора результатов!", vbExclamation, "GetNextPivot"
		Exit Function
	End If
	
	' Проверка, что документ Output не изменился между вызовами функции. Если изменился: сообщение и выход
	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
Related pages

...

Navigate from here