'Save as ExportVisibleOutputToWordViaHTML.SBS
'Begin DESCRIPTION
'This script copies all visible items of the Designated Output to MS Word. This is done via HTML.
' The ** indicating significance in Correlations Tables "survive" the trip to Word
'REQUIREMENTS:
' Need an open Output window (Visible content will be sent to Word via Htlm)
' This was tested with English versions of SPSS 10.07 and MS Word 2000;
' It should also work with other languages of these versions
' Note that the temporary files holding the HTML files are created in "c:\\temp\\".
'End DESCRIPTION
'Author: rlevesque@videotron.ca 2001/07/14
'http://pages.infinit.net/rlevesqu/
Option Explicit
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
' This is the temporary file containing the HTML output
strFile = "c:\\temp\\ExportToWord.htm"
Kill strFile 'Kill file if it already exists
objOutputDoc.Visible = True
' Export all visible objects to HTML documents
objOutputDoc.ExportDocument (SpssVisible, strFile, SpssFormatHtml, True)
' Next Sub imports the HTML documents into Word
Call ImportHTMLToWord (strFile)
Kill strFile
Exit Sub
ErrorHand:
Select Case Err
Case 10101 'File could not be killed
Resume Next
Case Else
Debug.Print Err & " " & Err.Description
MsgBox "Sorry, an error occured! You will have to try to solve the problem."
End Select
End Sub
'********************************
Sub ImportHTMLToWord (strFile As String)
'imports the HTML documents into Word
Dim WordApp As Object
On Error GoTo Oopps
'get access to Word application (if it does not exist, Oopps will create it)
Set WordApp=GetObject(,"Word.Application")
With WordApp
If .Documents.Count = 0 Then ' we need to add a document
.Documents.Add DocumentType:=0 'wdNewBlankDocument
End If
' Import the HTML document into Word
.Selection.InsertFile FileName:=strFile, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
Call WordMacro(WordApp)
End With
Set WordApp = Nothing
Exit Sub
Oopps:
Select Case Err
Case 10096 'word is not running: use CreateObject
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Debug.Print "error " & Err & ": " & Err.Description & "(Word was not already running)"
Resume Next
Case Else
Debug.Print "error " & Err & ": " & Err.Description
Set WordApp = Nothing
Exit Sub
End Select
End Sub
Sub WordMacro(WordApp As Object)
' To include the charts inside the Word document (instead of having
' a links to the charts)
Const wdPasteMetafilePicture=3
Const wdFloatOverText=1
Dim idx As Integer
On Error GoTo ErrorHand
'With WordApp
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
'End With
ErrorHand:
Debug.Print Err.Description
Exit Sub
End Sub