'Сохранение оглавления (Table Of Content = TOC) текущего окна результатов в текстовый файл. 'Данная версия создаёт оглавление в файле c:\\temp\\TOC.txt. Поменяйте имя и путь по своим надобностям. 'Скрипт добавляет последовательную нумерацию к заголовкам большинства объектов в окне результатов '(исключения составляют объекты GRAPH; их непросто изменить скриптом, а использование инструкции 'SendKeys будет проблематично). 'Те же номера и заголовки появляются в импровизированном оглавлении, которое записывается в текстовый файл. 'Нумеруются и включаются в оглавление только видимые объекты окна результатов. 'Автор: rlevesque@videotron.ca, 19.05.2001 'http://www.spsstools.net Option Explicit Sub Main Dim objOutDoc As ISpssOutputDoc, objItems As ISpssItems, objPivotTable As PivotTable Dim objIGraph As ISpssIGraph, objSpssText As ISpssrtf Dim strLabel As String, ItemIndex As Long, intTab As Integer 'Нам нужно работать лишь если имеется, по крайней мере, одно открытое окно результатов. If objSpssApp.Documents.OutputDocCount > 0 Then 'Привязываемся к текущему окну результатов. Set objOutDoc = objSpssApp.GetDesignatedOutputDoc Set objItems = objOutDoc.Items Else MsgBox "Нет открытого окна результатов!" Exit Sub End If Open "c:\\temp\\TOC.txt" For Output As #1 Print #1, "Оглавление составлено " & Now For ItemIndex=0 To objItems.Count-1 With objItems.GetItem(ItemIndex) If .Visible Then ' Debug.Print .SPSSType Select Case .SPSSType Case SPSSUnknown, SPSSRoot, SPSSPageTitle, SPSSWarning ' ничего не делаем Case SPSSNote .Label = "# " & ItemIndex & " " & .Label strLabel = .Label Set objPivotTable=.ActivateTable objPivotTable.TitleText= "# " & ItemIndex & " " & objPivotTable.TitleText strLabel=objPivotTable.TitleText Print #1, Space$(.Level * 3) & strLabel .Deactivate Case SPSSPivot ' Изменяем метку в дереве результатов .Label = "# " & ItemIndex & " " & .Label Print #1, Space$(.Level * 3) & .Label ' Изменяем текст в заголовке таблицы Set objPivotTable=.ActivateTable strLabel=objPivotTable.TitleText objPivotTable.TitleText= "# " & ItemIndex & " " & objPivotTable.TitleText .Deactivate Case SPSSTitle, SPSSLog, SPSSText ' Изменяем метку в дереве результатов .Label = "# " & ItemIndex & " " & .Label Print #1, Space$(.Level * 3) & .Label ' Изменяем текст в окне выдачи Set objSpssText = .ActivateText objSpssText.Text = "# " & ItemIndex & " " & objSpssText.Text .Deactivate Case SPSSChart ' Метка в дереве результатов .Label = "# " & ItemIndex & " " & .Label Print #1, Space$(.Level * 3) & .Label Case SPSSIGraph ' Метка в дереве результатов .Label = "# " & ItemIndex & " " & .Label Print #1, Space$(.Level * 3) & .Label ' Текст в заголовке (IGraphTitle) в окне результатов Set objIGraph = .Activate objIGraph.Title = "# " & ItemIndex & " " & objIGraph.Title objIGraph.Redraw .Deactivate Case Else .Label = "# " & ItemIndex & " " & .Label Print #1, Space$(.Level * 3) & .Label End Select Print #1, Space$(1) 'Пропускаем одну строку между объектами End If End With Next ItemIndex End Sub