Sub CreateMemo()
Dim myArray()
Dim wdBkmk As String
Dim wdApp As Word.Application
Dim wdRng As Word.Range
myArray = Array("To", "CC", "From", "Subject", "Chart")
Set wdApp = GetObject(, "Word.Application")
Set wdRng = wdApp.ActiveDocument.Bookmarks(myArray(0)).Range
wdRng.InsertBefore ("B")
Set wdRng = wdApp.ActiveDocument.Bookmarks(myArray(1)).Range
wdRng.InsertBefore ("T")
Set wdRng = wdApp.ActiveDocument.Bookmarks(myArray(2)).Range
wdRng.InsertBefore ("M")
Set wdRng = wdApp.ActiveDocument.Bookmarks(myArray(3)).Range
wdRng.InsertBefore ("F")
Set wdRng = wdApp.ActiveDocument.Bookmarks(myArray(4)).Range
ActiveSheet.ChartObjects("Chart 1").Copy
wdRng.PasteAndFormat Type:=wdPasteOLEObject
wdApp.Activate
Set wdApp = Nothing
Set wdRng = Nothing
End Sub
|