Автоподгонка строк и столбцов всех мобильных таблиц

 

Загрузить как .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
Sub Main
'Назначение: применение автоподгонки строк и столбцов (Autofit) ко всем мобильным таблицам (Pivot Tables)
'Условия: в системе SPSS открыт документ выдачи (Output Doc - Navigator)
'Результаты: происходит автоматическая подгонка ширины строк и столбцов в мобильных таблицах.
'Входящие параметры: нет.
'Возвращаемые значения: нет.

' Перевод: А. Балабанов, 17.11.2008.
' Проверено: SPSS 15.0.1.1.
' Autofit - опция, которую пользователь может выбрать самостоятельно из меню Format, когда он находится в режиме
' активированной мобильной таблицы - примеч. перев.

	Dim objDocuments As ISpssDocuments     	' Переменная, содержащая ссылки на документы SPSS
	Dim objOutputDoc As ISpssOutputDoc      ' Документ выдачи
	Dim objItems As ISpssItems       		' Объекты выдачи
	Dim objPivotTable As PivotTable			' Объект мобильной таблицы
	Dim i As Integer
		
	'Получение перечня открытых документов SPSS
	Set objDocuments = objSpssApp.Documents
		
	' Получаем ссылку на текущий документ выдачи только после проверки, что в системе открыт минимум один такой документ
	' Пропуск этого условия может приводить к ошибкам выполнения скрипта
	If objDocuments.OutputDocCount > 0 Then
	   'Get the currently designated output document.
	   Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Else
		'Если открытых документов выдачи нет, выходим из скрипта
		'Можете закомментировать следующую строку, тогда выход будет осуществляться без всяких сообщений пользователю
		MsgBox "Пожалуйста, откройте окно выдачи перед запуском скрипта", vbExclamation, "Ошибка выполнения скрипта"
		Exit Sub
	End If
	
	' Получение ссылки на объекты текущего окна выдачи
	Set objItems = objOutputDoc.Items

	' Цикл по всем объекам навигатора
	For i = 0 To objItems.Count - 1
		Set objItem = objItems.GetItem(i)				'Ссылка на очередной объект
		If objItem.SPSSType = SPSSPivot Then 			'Проверяем, является ли объект мобильной таблицей
			Set objPivotTable = objItem.ActivateTable()	'Активация объекта как мобильной таблицы
			objPivotTable.UpdateScreen = False			'Запрещаем немедленную перерисовку изменяемого объекта
			
			'*************************************************************
			'* Сюда (между звёздочками) вы можете вставить ещё какие-то свои инструкции,
			'* которые работают с активированной мобильной таблицей
			
			'Здесь мы применяем к таблице автоподгонку:
			objPivotTable.Autofit

			'*************************************************************
			
			'Теперь перерисуем таблицу (разом, а не колонку за колонкой)
			objPivotTable.UpdateScreen = True
			
			'Завершение работы: необходимо деактивировать таблицу.
			'При этом надо помнить, что активация применялась не к сводной таблице как таковой,
			'а к объекту окна навигатора (Item).
			objItem.Deactivate
        End If
	Next
			
End Sub
Related pages

...

Navigate from here