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
'BEGIN DESCRIPTION
'Предполагается, что объект objSpssApp представляет запущенное приложение SPSS.
'Скрипт задаёт каждой мобильной таблице в Навигаторе (окне выдачи результатов)
'новый шаблон форматирования (TableLook), который может быть выбран через диалоговое окно.
'Скрытые таблицы также подвергаются форматированию.
'Автор: Arnd Winter, SPSS Germany.
'END DESCRIPTION

'Описание на немецком языке:
'Dieses Skript setzt voraus, daЯ objSpssApp die gegenwдrtig
'ausgefьhrte SPSS-Anwendung ist und weist allen vorhandenen Tabellen
'im Ouput-Navigator nachtrдglich eine
'neue Tabellenansicht zu, die per Dialogbox ausgewдhlt wird.
'Auch nicht eingeblendete, aber vorhandene Tabellen werden verдndert.
'Erstellt von SPSS GmbH Software, Mьnchen, Deutschland.
'Autor: Arnd Winter

' Перевод: А. Балабанов, 17.11.2008.
' Проверено: SPSS 15.0.1.1.
' Перед применением шаблонов необходимо позаботиться об их настройке под кириллические шрифты - примеч. перев.

Sub Main

On Error GoTo Bye

' Объявление переменных / Deklarieren von Variablen

Dim objOutputDoc As ISpssOutputDoc
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Dim strAppPath As String
Dim objOutputItems As ISpssItems
Dim objOutputItem As ISpssItem
Dim objPivotTable As PivotTable
Dim intCount As Integer
Dim varStrLook As String
Set objOutputItems=objOutputDoc.Items

' Определение папки, куда установлена SPSS / SPSS-Verzeichnis ermitteln
strAppPath = objSpssApp.GetSPSSPath

' Выбор шаблона (TableLook) / Tabellenansicht auswдhlen
' Для немецкого варианта скрипта активируйте первую из 2-х следующих строк, вместо второй
'VarStrLook = GetFilePath$("*.tlo","tlo",strAppPath,"Bitte Tabellenansicht auswдhlen und mit Speichern bestдtigen",4)
varStrLook = GetFilePath$("*.tlo","tlo",strAppPath,"Выберите TableLook и подтвердите выбор кнопкой Сохранить",4)


' Если выбрана "Отмена", либо выбран неправильный тип файла, выходим из скрипта
' Wenn abbrechen gedrьckt oder falsche Datei gewдhlt, Programm verlassen

If (Len(varStrLook)= 0) Or (Right(varStrLook,3)<>"tlo") Then
	Exit Sub
End If 	

' Цикл, приписывающий выбранный шаблон TableLook всем таблицам.
' Schleife, die alle Tabellen im Output Navigator aktiviert und
' die ausgewдhlte Tabellenansicht zuweist

intCount = objOutputItems.Count
For I = 0 To intCount-1
	Set objOutputItem=objOutputItems.GetItem(I)
	If objOutputItem.SPSSType=SPSSPivot Then
		Set objPivotTable=objOutputItem.ActivateTable
		objPivotTable.TableLook = varStrLook
		objOutputItem.Deactivate
	End If
Next 
Bye:
End Sub