Export visible output to word via HTML v2

 

Download as .sbs Shows as plain text

 

  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
'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
Related pages

...

Navigate from here