View Single Post
 
Old 02-05-2013, 06:06 AM
Hdr Hdr is offline Windows 7 64bit Office 2007
Novice
 
Join Date: Feb 2013
Posts: 5
Hdr is on a distinguished road
Default Bookmark in header or shape or table still does not work

Thanks for you reply,

In answer to your questions; the template i can not change, therefor I have to add the reference to (in this case) the date on the second page.

Sadly enough I get an error message when I try to add a field in a table or shape in the header, this is the reason I was trying the macro with selecting.
Getting the information in the bookmark and adding text to the bookmark is no problem, but adding a field gives an error.
Hopefully you have an answer, Many thanks in advance for all the help!
Vance
---------------------------------
I tried several options, see below

My Macro now:

Sub CreateWordDocFromExcel_BM2()
'LATE BINDING METHOD - Reference to Word not required.
Dim objWord As Object 'Note Object in lieu of Word.Application
Dim objDoc As Object 'Note Object in lieu of Word.Document
Dim strTemplatePathAndName As String, StrBkMkNm As String
Dim wdRng As Object

'Late binding requires constants to be declared with values
Const wdPaneNone = 0
Const wdOutlineView = 2
Const wdPrintView = 3
Const wdNormalView = 1
Const wdSeekCurrentPageHeader = 9
Const wdSeekCurrentPageFooter = 10
Const wdFieldEmpty = -1
Const wdSeekMainDocument = 0
Const wdAlignParagraphCenter = 1
Const wdAlignParagraphRight = 2

'Try GetObject first in case Word Application is already open.
Set objWord = Nothing
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
On Error GoTo 0

If objWord Is Nothing Then 'Word not open so create object
Set objWord = CreateObject("Word.Application")
End If

With objWord
'Create a new Word document
.Visible = True 'Can be false
Set objDoc = .Documents.Add 'If no template
AppActivate (objDoc.Name)
End With



'Dim wdRng As object.Range (probably does not accept this in Late Binding)
'I added the bookmarks below in the Word-doc (while the macro runs - with F8) - MySpots = in shape in header, MySpot = in table in header - MyReference = in main document - MyReference2 = in main document.

With objDoc
StrBkMkNm = "Myspots"
Set wdRng = .bookmarks("Myspots").Range
'Insert header (bookmark MySpot is in Header, Bookmark Myspots is in table in header, Bookmark MyReference is in normal text)
'Next line works:
.bookmarks("MySpots").Range.Text = "Hello!"
'Next lines do NOT work:
.Fields.Add Range:=.bookmarks(StrBkMkNm).Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Fields.Add Range:=.Sections(1).Headers(1).Shapes(1).TextFrame .Textrange.bookmarks(StrBkMkNm).Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Fields.Add Range:=.Sections(1).Headers(1).tables(1).bookmarks ("MySpot").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Sections(1).Headers(1).tables(1).Fields.Add Range:=.bookmarks("MySpot").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Sections(1).Headers(1).Shapes(1).TextFrame.Textra nge.bookmarks("MySpots").Fields.Add Range:=.bookmarks("MySpots").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Sections(1).Headers(1).tables(1).Fields.Add Range:=.bookmarks("MySpot").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.Sections(1).Headers(1).Shapes(1).TextFrame.Textra nge.bookmarks("MySpots").Range.Fields.Add Range:=.Sections(1).Headers(1).Shapes(1).TextFrame .Textrange.bookmarks("MySpots").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
'Next msgbox does work:
MsgBox .Sections(1).Headers(1).Shapes(1).TextFrame.Textra nge.bookmarks("MySpots").Range
'Next line does work with a bookmark in the main document (MyReference2 is a bookmark in the main document)
.Fields.Add Range:=.bookmarks("MyReference2").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False
.bookmarks.Add Range:=wdRng, Name:=StrBkMkNm
End With

'Clean up
Set objDoc = Nothing
Set objWord = Nothing
End Sub
Reply With Quote