View Single Post
 
Old 02-04-2013, 03:16 PM
Hdr Hdr is offline Windows 7 64bit Office 2007
Novice
 
Join Date: Feb 2013
Posts: 5
Hdr is on a distinguished road
Default Excel vba adding field in word table/shape in a header

L.S.,I am trying to add fields in word with excel vba with late binding.This works for simple bookmarks, but i need to add a field to a bookmark in a table/shape in the header.I have the following code, in which you see that most works, accept the line that i need to have working. Could someone please help?Thanks in advance!Vance
Here is the code:
Code:Sub CreateWordDocFromExcel_BM() '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 '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 With objWord If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .ActiveWindow.Panes(2).Close End If If .ActiveWindow.ActivePane.View.Type = wdNormalView Or .ActiveWindow. _ ActivePane.View.Type = wdOutlineView Then .ActiveWindow.ActivePane.View.Type = wdPrintView End If 'Insert header (bookmark MySpot is in Header, Bookmark Myspots is in table in header, Bookmark MyReference is in normal text) .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 'Following text works: .Selection.Fields.Add Range:=.Selection.Range, Type:=wdFieldEmpty, Text:= _ "REF MyReference \*Charformat \*Mergeformat ", PreserveFormatting:=True 'Following text works: .bookmarks("MySpot").Select 'Following text works: objDoc.bookmarks("MySpot").Select Set MyBookmark = objDoc.bookmarks("MySpot").Range MyBookmark.Text = "" 'Following text works, in table a whole field is bookmarked as "Myspots" - so the bookmark does not dissappear Set MyBookmark = objDoc.bookmarks("MySpots").Range MyBookmark.Text = "" 'Next does NOT work and I need this to work (adding a field in a header in a table or shape) MyBookmark.Fields.Add Range:=MyBookmark, Type:=wdFieldEmpty, Text:= _ "REF MyReference \*Charformat \*Mergeformat ", PreserveFormatting:=True End With 'Clean up Set objDoc = Nothing Set objWord = Nothing
End Sub