Hi Guys,
I have found a routine from an old post on this forum - Excel range into word bookmark range (sorry can't seem to link to the page).
' ' Proof of concept code that will take all the named values in
' the worsheet ResultTalbes and insert them into the document
' defined at the top of the sheet with using the vlaues for
' Target Word File, and Target Word Doc.
'
'
Option Explicit
Sub insertIntoWordBookmark()
' define error handler
On Error GoTo ErrorHandler
'
' resltValues is a collection of the names from the ResultTables
' worksheet
Dim resultValues As Collection
Set resultValues = New Collection
' resultValues is an excel name object as a member of the resultValues collection
Dim resultValue As Excel.Name
'
' declare and set the variable nms a the active workbooks
' names collection. The workbooks names collection contains
' all the workbook's named cell rangesthese will be used to
' insert the target word document.
Dim nms As Excel.names
Set nms = ActiveWorkbook.names
'
' loop incrementer
Dim i As Integer
'
' create the word target document, the document is set later it the script
Dim targetWord As Word.Document
'
' loop through excel named ranges and set the name of the bookmarks that
' will be updated are only from the worksheet named Result Tables
For i = 1 To nms.Count
'copy range value
' If nms(i).RefersToRange.Parent.Name = "ResultTables" Then
resultValues.add Item:=nms(i), Key:=nms(i).Name
' End If
Next i
'
'
' create and set the word application object
Dim appWord As Word.Application
Set appWord = New Word.Application
' open word doc
Dim pathToWord As String
pathToWord = Range("targetWordDir") & Range("targetWordFile")
Set targetWord = appWord.Documents.add(pathToWord)
'
' loop through the word document and create a temporary collection
' of the documents original bookmarks, the script will delete any
' new bookmarks that are introduce by the insertion process.
Dim oBookmarks As Collection
Dim oBookmark As Word.bookmark
Dim delete As Boolean
'
Set oBookmarks = New Collection
For Each oBookmark In targetWord.Bookmarks
oBookmarks.add Item:=oBookmark, Key:=oBookmark.Name
Next oBookmark
'
' loop through our results and paste into word
For Each resultValue In resultValues
If targetWord.Bookmarks.Exists(resultValue.Name) Then
' determine if the source area in Excel is a single cell range, or a
' multiple cell range.
If resultValue.RefersToRange.Count > 1 Then
' we have a table
insertTable targetWord, resultValue
ElseIf resultValue.RefersToRange.Count = 1 Then
' we have a value
insertValue targetWord, resultValue
End If
End If
Next resultValue
'
' clean up any introduced bookmarks
Dim targetBookmark As Word.bookmark
For Each targetBookmark In targetWord.Bookmarks
delete = True
For Each oBookmark In oBookmarks
If UCase(oBookmark.Name) = UCase(targetBookmark.Name) Then
delete = False
' found a match break out of loop
Exit For
End If
Next oBookmark
' delete bad bookmark
If delete Then
targetBookmark.delete
End If
Next targetBookmark
'
' activate word document
With appWord
.Visible = True
.ActiveWindow.WindowState = 1
.Activate
End With
ErrorExit:
Set appWord = Nothing
Set targetWord = Nothing
Exit Sub
'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & ". " & Err.Description
If Not appWord Is Nothing Then
appWord.Quit False
End If
Resume ErrorExit
End If
End Sub
' inserts a single cell range excel value into a word document "targetWord" at
' the insertion point bookmarkName
Sub insertValue(targetWord As Word.Document, bookmarkName As Excel.Name)
Dim myRange As Word.Range
'
' check that the bookmark exists in both excel and word
If targetWord.Bookmarks.Exists(bookmarkName.Name) Then
'
' activate the word doucment, got and update the current bookmark
Set myRange = targetWord.Bookmarks(bookmarkName.Name).Range
'
' redefine the text value of the range
myRange.Text = bookmarkName.RefersToRange.Text
'
' redefine the bookmark because it is destroyed when the value
' is changed.
myRange.Bookmarks.add Name:=bookmarkName.Name
End If
End Sub
' pastes a range of excel values into a word document "targetWord" at
' the insertion point bookmarkName
Sub insertTable(targetWord As Word.Document, bookmarkName As Excel.Name)
'
' this is the range of the insertion point in the target document
Dim myRange As Word.Range
Dim newRange As Word.Range
'
' check that the bookmark exists in both excel and word
If targetWord.Bookmarks.Exists(bookmarkName.Name) Then
'
' set target range, cordinates of the insertion point in the word document
Set myRange = targetWord.Bookmarks(bookmarkName.Name).Range
'
' check if we are in a table
If myRange.Information(wdWithInTable) Then
' if so, delete the table
myRange.Tables(1).delete
End If
'
' copy the result table from xl
Range(bookmarkName.Name).Copy
'
' collapse range so our insertions don't overlap with ranges
myRange.Collapse Direction:=wdCollapseStart
'
' The myRangeStart variable is used to store the static location of the start
' position of the myRange. When the paste method is executed the start position
' changes and the original is needed to reset the bookmark.
Set newRange = targetWord.Range(myRange.Start, myRange.Start)
'
' paste table
myRange.PasteSpecial Link:=False, DataType:=wdPasteHTML
'
' reset target bookmark
targetWord.Bookmarks.add Name:=bookmarkName.Name, Range:=newRange
End If
End Sub
The code copies text/tables from named ranges into a word document with bookmarks of the same name. I would like to extend on this to also copy any charts to the bookmarks at the same time. Is this achievable or is there an alternative solution somebody could suggest?
Thanks in advance.