zaprat2
02-04-2008, 09:19 PM
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
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