How about something like this to get you started:
Option Explicit
Sub ChartToDocument2A()
Const wdPasteMetafilePicture As Long = 3
Const wdInLine As Long = 0
Const wdNewBlankDocument As Long = 0
Const wdFormatDocument As Long = 0
'Dim WDApp As Word.Application
'Dim WDDoc As Word.Document
Dim WDApp As Object
Dim WDDoc As Object
Dim wWsht As Worksheet
Dim sShape As Shape
Dim WordWasRunning As Boolean
WordWasRunning = True
On Error Resume Next
Set WDApp = GetObject(, "Word.Application")
If Err.Number < 0 Then
Set WDApp = CreateObject("Word.Application")
WordWasRunning = False
End If
WDApp.Visible = True 'at least for testing!
With WDApp
.AppRestore
.AppMaximize 1
Set WDDoc = .Documents.Add(documenttype:=wdNewBlankDocument)
.InsertPara
End With
For Each wWsht In ThisWorkbook.Worksheets
For Each sShape In wWsht.Shapes
sShape.CopyPicture
WDApp.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
Next sShape
Next wWsht
WDDoc.SaveAs Filename:="C:\my documents\word\test11.doc", _
FileFormat:=wdFormatDocument
WDDoc.Close savechanges:=False
If WordWasRunning Then
'leave it running
Else
WDApp.Quit
End If
Set WDDoc = Nothing
Set WDApp = Nothing
End Sub
Notice that when you don't have the reference to word, you can't use the Word
constants.
I declared them as constants in this section:
Const wdPasteMetafilePicture As Long = 3
Const wdInLine As Long = 0
Const wdNewBlankDocument As Long = 0
Const wdFormatDocument As Long = 0
I opened word, got to its VBE and hit ctrl-g to see the immediate window.
Then I did
?wdPasteMetafilePicture
and got
3
back
Same with all the word constants I used.
I find it much easier to develop with the reference. But before I release the
workbook to the wild, I change the early binding stuff to late binding.
You may want to look at these links that Tom Ogilvy posted recently:
Here are some more extensive references on binding:
Use late binding - don't have a reference to excel.
http://support.microsoft.com/default...b;EN-US;244167
INFO: Writing Automation Clients for Multiple Office Versions
http://support.microsoft.com/default...b;en-us;245115
INFO: Using Early Binding and Late Binding in Automation
http://support.microsoft.com/default...b;en-us;247579
INFO: Use DISPID Binding to Automate Office Applications Whenever Possible
and Dick Kusleika has a web page at:
http://www.dicks-clicks.com/excel/olBinding.htm
that explains this with Outlook
Gunnar Johansson wrote:
Hi,
I need to paste ranges and charts in to a new word file but don't know what
the user have.
From the enclosed code, I try to figure out how to make it flexible to
unknown 97 office users. I don't want to force any to go into VBE and
change objcet library etc. There must be a way - without access the
registry, that is to advanced for me - to paste charts and ranges to a new
word file.
Any suggestions?
/Regards
Sub ChartToDocument2()
'Here we use early binding and therefore we need to set
'a reference to MS Word Object Library x.x via the Tools | Reference...
'in the VB-editor.
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Set Word6 = CreateObject("Word.Basic")
With Word6
.AppRestore
.AppMaximize 1
.FileNewDefault
.InsertPara
End With
' Reference existing instance of Word
Set WDApp = GetObject(, "Word.Application.10")
' Reference active document
Set WDDoc = WDApp.ActiveDocument
' Reference active slide
For Each wWsht In ThisWorkbook.Worksheets
For Each sShape In wWsht.Shapes
sShape.CopyPicture
WDApp.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
Next sShape
Next wWsht
End Sub
Sub Excel_Range_Word()
'Here we use early binding which means that a
'reference must be set to MS Word Object Library x.x
'via Tools |Reference in the VB-editor
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim BMRange As Word.Range
Dim oShape As Word.InlineShape
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet")
With wsSheet
Set rnReport = .Range("Rapport")
End With
--
Dave Peterson