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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130 | 'Описание
' Экспорт сводных таблиц (Pivot Tables) и/или графиков из файлов spo в заданной папке по заданной маске в файлы HTM
' Скрипт обрабатывает все файлы по заданной маске, например, "*.spo", "out*.spo",
' в указанной папке.
' Допустим, первые 2 файла называются "output1.spo" и "myoutput.spo".
' Тогда будет открыт файл "output1.spo", и все сводные таблицы и/или графики будут выделены
' и экспортированы в HTM-файл с именем "output1.htm".
' Аналогично, все таблицы из "myoutput.spo" будут экспортированы в "myoutput.htm".
'Конец описания
' Размещено в SPSSX-L 15.09.2001, автор: rlevesque@videotron.ca
' http://www.spsstools.net
Option Explicit
' Исправьте следующие 2 строки так, как вам нужно
Const bolTABLE = True 'True означает экспорт всех объектов такого типа
Const bolCHART = True 'False означает "не экспортировать"
Sub Main
Dim objDocuments As ISpssDocuments
Dim objOutputDoc As ISpssOutputDoc
Dim strPath As String
Dim strFileMask As String
Dim strFname As String
Dim intCount As Integer
Dim i As Integer
'Определим путь к файлам и маску
strPath ="c:\\temp\\"
strFileMask ="*.spo"
'Получаем имя первого файла результатов
strFname = Dir$(strPath & strFileMask)
Set objDocuments = objSpssApp.Documents
While strFname <> ""
' Debug.Print strFname
' Открываем Output, делаем его видимым, выделяем все сводные таблицы:
Set objOutputDoc = objSpssApp.OpenOutputDoc(strPath & strFname)
objOutputDoc.Visible = True
Call SelectItems(objOutputDoc)
Call ExportPivotTablesToHTML(objOutputDoc, strPath, strFname)
' Для экономии памяти закрываем все файлы output, кроме активного (designated)
'(использование "objOutputDoc.Close" для активного файла в ранних версиях SPSS "убивает" spsswin.exe!)
intCount = objDocuments.OutputDocCount
For i = 0 To intCount - 1
Set objOutputDoc = objDocuments.GetOutputDoc(i)
If Not objOutputDoc.Designated Then
objOutputDoc.Close
End If
Next
'Переходим к следующему файлу
strFname = Dir$()
Wend
Set objOutputDoc = Nothing
End Sub
'****************************
Sub ExportPivotTablesToHTML ( _
objOutputDoc As ISpssOutputDoc, _
strPath As String, _
strFname As String)
' Экспорт выделенных объектов в HTML
' Имя файла HTM такое же, как и у файла SPO
Dim strFile As String
On Error GoTo ErrorHand
' Определим имя файла HTML
strFile = strPath & Left(strFname,InStr(strFname,".")) & "htm"
Kill strFile 'Если файл с таким именем уже существует, сотрём его
' Экспорт выделенных объектов в HTML
objOutputDoc.ExportDocument (SpssSelected, strFile, SpssFormatHtml, True)
Exit Sub
ErrorHand:
Select Case Err
Case 10101 'Файл не может быть удалён
Resume Next
Case Else
Debug.Print Err & " " & Err.Description
MsgBox "К сожалению, произошла ошибка! Попробуйте разобраться, в чём дело."
Exit Sub
End Select
End Sub
' выделение объектов заданного типа
Sub SelectItems(objOutput As ISpssOutputDoc)
Dim objItems As ISpssItems
Dim objItem As ISpssItem
Dim lngCount As Long
Dim i As Integer
Set objItems = objOutput.Items
lngCount = objItems.Count
' находим и выделяем объекты заданного типа
For i = lngCount - 1 To 0 Step -1
Set objItem = objItems.GetItem(i)
Debug.Print objItem.SPSSType
Select Case objItem.SPSSType
Case 1 'График
If bolCHART = True Then
objItem.Selected = True
Else
objItem.Selected = False
End If
Case 5 'Сводная таблица
If bolTABLE=True Then
objItem.Selected = True
Else
objItem.Selected = False
End If
Case Else
objItem.Selected = False
End Select
Next
End Sub
|