Экспорт видимой выдачи в Word через HTML
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 | 'Перенос видимых результатов из SPSS в Word через HTML. 'Данный скрипт экспортирует все видимые объекты из окна назначения результатов в MS Word. С промежуточной ' конвертацией в HTML. ' ВНИМАНИЕ! Константа EMLINK (см. ниже) определяет, вставлять ли рисунки как ссылки (True), ' или интегрировать в документ как картинку (False - по умолчанию) - модиф. перев. ' При этом графики не встраиваются в Word, на них создаются ссылки. ' Значки (**) будут обозначать значимые корреляции. Так они видоизменяются при экспорте в Word. 'ТРЕБОВАНИЯ: 'Необходимо открытое окно результатов (видимое содержимое будет передано в Word через HTML). 'Тестировалось с английской версией SPSS 10.07 и редактором MS Word 2000; 'В принципе, должно работать и на локализованных вариантах этих версий; 'Обратите внимание, что временный файл формата HTML для транзита выдачи создаётся в папке "c:\\temp\\". 'Сохраните этот файл как ExportVisibleOutputToWordViaHTML.SBS 'Автор:: rlevesque@videotron.ca, 14.07.2001 'http://www.spsstools.ru ' Перевод: А. Балабанов, 09.11.2008 ' Проверено: SPSS 13.0, MS Word 2003. Option Explicit Const EMLINK As Boolean = False Sub Main Dim intType As Integer Dim objOutputDoc As ISpssOutputDoc Dim objItems As ISpssItems Dim objItem As ISpssItem Dim strFile As String On Error GoTo ErrorHand Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc ' Это - путь ко временному файлу, который будет содержать выдачу в формате HTML strFile = "c:\\temp\\ExportToWord.htm" Kill strFile 'Удалим файл, если он уже существует objOutputDoc.Visible = True ' Экспорт всех нескрытых объектов из окна результатов SPSS в файл HTML objOutputDoc.ExportDocument (SpssVisible, strFile, SpssFormatHtml, True) ' Следующая процедура импортирует файл HTML в Word Call ImportHTMLToWord (strFile) Kill strFile Exit Sub ErrorHand: Select Case Err Case 10101 'Невозможно удалить временный файл HTML Resume Next Case Else Debug.Print Err & " " & Err.Description MsgBox "Произошла ошибка." End Select End Sub '******************************** Sub ImportHTMLToWord (strFile As String) 'импорт файла HTML в документ Word Dim WordApp As Object On Error GoTo Oopps 'получим доступ к приложению Word (если оно ещё не запущено, инструкции после метки "Oopps" запустят его) Set WordApp=GetObject(,"Word.Application") With WordApp If .Documents.Count = 0 Then ' если в Word нет открытых документов, придётся добавить новый документ .Documents.Add DocumentType:=0 '0=константа wdNewBlankDocument End If ' Импорт файла HTML в Word .Selection.InsertFile FileName:=strFile, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False If Not EMLINK Then Call WordMacro(WordApp) End With Set WordApp = Nothing Exit Sub Oopps: Select Case Err Case 10096 'Приложение Word не запущено, следовательно, вместо GetObject надо использовать CreateObject Set WordApp = CreateObject("Word.Application") WordApp.Visible = True Debug.Print "error " & Err & ": " & Err.Description & "(Word не был запущен)" Resume Next Case Else Debug.Print "error " & Err & ": " & Err.Description Set WordApp = Nothing Exit Sub End Select End Sub Sub WordMacro(WordApp As Object) ' В случае, если экспортированный график вставился как ссылка, данный макрос интегрирует его ' в документ Word, помещая как картинку над текстом. Иначе - просто помещает картинку "перед текстом" Const wdPasteMetafilePicture=3 Const wdFloatOverText=1 Dim idx As Integer On Error GoTo ErrorHand For idx = WordApp.ActiveDocument.InlineShapes.Count -1 To 0 Step -1 WordApp.ActiveDocument.InlineShapes(idx).Select WordApp.Selection.Copy WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdFloatOverText, DisplayAsIcon:=False Next idx ErrorHand: Debug.Print Err.Description Exit Sub End Sub |
Related pages
...