Excel range into word bookmark range

[zaprat2]

Hi All,

I'm trying to write a script that will take the named ranges from an excel spreadsheet and insert the values into similarlly named bookmarks in word. I have found that I can set the word.bookmarks(n).range.text value to an excel range that is a single cell with no problem. The problem that I'm having is trying to get an excel range that is larger than a single cell (a table) into the word.bookmarks(n).range.text property.

I would rather work with the range collection in word because the bookmarks have to be preserved.

Any ideas, the code is below?

Thanks,
Chris :banghead:

Attribute VB_Name = "inserterValue"

'

' Proof of concept code that will take all the named values in

' the worsheek ResultTables 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 exportToWord()

' 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



Dim xl As Object

Set xl = ActiveWorkbook



'

' declaire 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 Object

Set nms = ActiveWorkbook.names



'

' When a bookmarkd is updated in Word the bookmark's

' position is lost and we have to reset it after updating

' for this we need to store the start and end positions.

Dim bookMarkStart As Long

Dim bookMarkEnd As Long



'

' loop incrementer

Dim i As Integer



'

' create and set the word application object

Dim appWord As Object

Set appWord = CreateObject("Word.Application")



'

' create the word target document, the document is set later it the script

Dim targetWord As Object



' create the bookmark rand

Dim bms As Word.Range



' loop through excel named ranges and get the ones we want from a specific
' work sheet.

For i = 1 To nms.Count

'copy range value

If nms(i).RefersToRange.Parent.Name = "ResultTables" Then

resultValues.Add Item:=nms(i)

End If

Next i



'

' open word doc

' Dim pathToWord As String

' pathToWord = resultValues("targetWordDir").RefersToRange.Text & "\" & resultValues("targetWordFile").RefersToRange.Text

'Set targetWord = appWord.Documents.Add("pathToWord")

Set targetWord = appWord.documents.Add("C:\Documents and Settings\Administrator\Desktop\Target Doc.doc")



'

' loop through our results and paste into word

For i = 1 To resultValues.Count

'

' check that the bookmark exists in both excel and word

If targetWord.Bookmarks.Exists(resultValues(i).Name) Then



'

' activate the word doucment, got and update the current bookmark

Set bms = targetWord.Bookmarks(resultValues(i).Name).Range

With bms

'

' redefine the text value of the range

' .Text = resultValues(i).Value 'this works fine for a single cell excel range
''''''''''''''''''''
' here be problems '
''''''''''''''''''''

.Text = resultValues(i).RefersToRange.Value2 ' thows type mismatch





'

' redefine the bookmark because it is destroyed when the value

' is changed.

.Bookmarks.Add Name:=resultValues(i).Name

End With

End If

Next i



'

' activate word document

With appWord

.Visible = True

.ActiveWindow.WindowState = 1

.Activate

End With



'

' clean up memory

Set appWord = Nothing

Set targetWord = Nothing



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

[JonPeltier]

You have to insert the multi-cell range as a table. I don't recall the precise syntax, but the approach is like thie pseudocode:

get the Excel name and the Word bookmark
is it a single cell
- insert cell contents as text into Word bookmark
is it a multiple cell range
- insert it as a table

The steps may involve copying the range and using one of the paste special options in Word.

[zaprat2]

Hi Jon,

Thanks for the advice, what you suggest is the path I ended up taking. The code below works, though it needs a little clean up :)



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

[mickoner]

I know this has been an inactive thread for a while, but I just want to thank you, zaprat2, for this excellent piece of VB. Works splendidly! :beerchug:

For my purposes, I made the following simple mods:

pathToWord = Range("targetWordDir") & Range("targetWordFile")
to
pathToWord = ThisWorkbook.Path & Range("targetWordFile")
and
myRange.PasteSpecial Link:=False, DataType:=wdPasteHTML
to
myRange.PasteSpecial Link:=False, DataType:=wdPasteBitmap

But other than that, this was copy-and-paste brillance.

Thank you!