|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Adding field in word in header in a bookmark in table with Excel vba Late Binding
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:
Last edited by macropod; 02-03-2013 at 11:50 PM. Reason: Added code tags & formatting |
#2
|
||||
|
||||
I assume you're trying to populate the bookmarked range. In that case, instead of:
Code:
With objWord ... End With Code:
With objDoc Dim wdRng As objWord.Range, StrBkMkNm As String 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) .Fields.Add Range:=.Bookmarks(StrBkMkNm).Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Bookmarks.Add Range:=wdRng, Name:=StrBkMkNm End With Note also that there is no need to 'seek' the header or to select anything.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
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 |
#4
|
||||
|
||||
Quote:
Set objDoc = .Documents.Add 'If no template which indicates you're using Word's Normal template instead of a specific template for this project. Were you to create a template for this project, and use: Set objDoc = .Documents.Add(Template:="Filepath\Filename.dotx") where 'Filepath\Filename.dotx' represents the template's path and name, your code could be much simpler. I also don't see any indication you've actually tried the code I posted or that you've paid any attention to my request in your other thread that you use code tags when posting code. I also reiterate my previous advice that you don't need to seek the header or select anything.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Opening a word document with a set word doc and layout
I'm sorry for not using the code tags, I will from now on.
I was trying to keep the code simple as not to confuse you with other code. My code with which I open a word document is below. The Word document has a set template (.dot) that it uses, which I sadly enough can not change or open. I fill the bookmarks in this document with Excel, but the letters (Word-documents) are protected. I could fill in the date (on the second page) with my document, but if the letter is printed a few days later and the date on the first page is altered the date on the second page in the shape/table in the header on the second page does not change automatically. The StyleRef Field is new to me, is this very different from the Ref Field? Maybe that will work. I try to simulate a Word document that looks alike with a shape and a table in the header and try my code to see if it works. By the way, I prefer not selecting anything like I do in Excel but I am not so familiar with macro's in Word. Your code I have tried, but it does not work because it gives an error, see code below (Set wdRng): Code:
With objDoc Dim wdRng As objWord.Range, StrBkMkNm As String StrBkMkNm = "MySpots" Set wdRng = .Bookmarks("MySpots").Range 'It gives an error on this line 'Insert header (bookmark MySpot is in Header, Bookmark Myspots is in table in header, Bookmark MyReference is in normal text) .Fields.Add Range:=.Bookmarks(StrBkMkNm).Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Bookmarks.Add Range:=wdRng, Name:=StrBkMkNm End With Code:
'Next line works: .bookmarks("BMshapeHeader").Range.Text = "Hello!" 'Next lines do NOT work: .Fields.Add Range:=.bookmarks("BMshapeHeader").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Fields.Add Range:=.Sections(1).Headers(1).Shapes(1).TextFrame .Textrange.bookmarks("BMshapeHeader").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Fields.Add Range:=.Sections(1).Headers(1).tables(1).bookmarks ("BMtableHeader").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Sections(1).Headers(1).tables(1).Fields.Add Range:=.bookmarks("BMtableHeader").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Sections(1).Headers(1).Shapes(1).TextFrame.Textra nge.bookmarks("BMshapeHeader").Fields.Add Range:=.bookmarks("BMshapeHeader").Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False My code that I use to open and fill out the bookmarks: Code:
Sub CreateWordDoc(Optional Dummy As String) Dim wdApp As Object Dim wdDoc As Object Dim wdFormField As Object Dim rCell As Range Dim rRng As Range, rngName As Range Dim lAdd As String Dim sName As String Dim fileToOpen As String, a As String Dim wdRng As Object, wdProtection As Long On Error GoTo Msg fileToOpen = Application _ .GetOpenFilename("WordDocumenten (*.doc*), *.doc*") If fileToOpen <> "" And fileToOpen <> False Then Msg: Err.Number = 0 Else: MsgBox "No file has been opened": Err.Number = 0: Exit Sub End If On Error GoTo ErrHandler Err.Number = 0 Application.ScreenUpdating = False Set rRng = Sheets(1).Range(Cells(2, 1), Cells(WordBereik, 1)) lScore = 100 'set the max possible score 'open the word documents Set wdApp = CreateObject("Word.Application") Set wdDoc = wdApp.documents.Open(fileToOpen) 'ActiveWorkbook.Path & "\Formsword.doc") 'loop through the range For Each rCell In rRng.Cells Set rngName = rCell 'if the bookmark is filled in If rCell.Offset(0, 1).Value <> "" Then 'store the data as variables lAdd = rCell.Offset(0, 1).Value sName = rCell.Value If rCell.Offset(0, 2).Value = "Datum" Then lAdd = Format(lAdd, "d mmmm yyyy") If rCell.Offset(0, 2).Value = "Bedrag" Then lAdd = Format(lAdd, "#,##0.00") If wdDoc.Bookmarks.exists(sName) = True Then For Each wdFormField In wdDoc.formfields If UCase(sName) = UCase(wdFormField.Name) Then a = "yes" Exit For End If Next wdFormField If a = "yes" Then wdDoc.formfields(sName).TextInput.EditType Type:=wdRegularText, Default:=lAdd a = "" Else UpdateBookmark sName, lAdd, wdDoc End If End If End If End If Next rCell wdDoc.fields.Update Err.Clear On Error Resume Next Err.Number = 0 On Error GoTo ErrHandler 'With Selection.FormFields("Datum").Name = "Datum" 'With .TextInput.EditType Type:=wdRegularText, Default:=Format(Now, "d mmmm yyyy"), _Format:="" 'show the word document wdApp.Visible = True Application.ScreenUpdating = True Exit Sub ErrHandler: wdApp.Quit Application.ScreenUpdating = True MsgBox "Er heeft zich een fout voorgedaan" End Sub Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String, WdDocument As Object) Dim BMRange As Object, MyStart As Range Set BMRange = WdDocument.Bookmarks(BookmarkToUpdate).Range BMRange.Text = TextToUse WdDocument.Bookmarks.Add BookmarkToUpdate, BMRange End Sub Quote:
|
#6
|
||||
|
||||
Try something based on the following:
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 wdRng As Object 'Note Object in lieu of Word.Range Dim fileToOpen As Variant Const StrBkMkNm As String = "MySpots" 'Late binding requires values or constants to be declared with values Const wdFieldEmpty = -1 Const wdWithInTable = 12 fileToOpen = Application.GetOpenFilename("WordDocuments (*.doc*), *.doc*") If fileToOpen = "" Or fileToOpen = False Then MsgBox "No file has been opened" Exit Sub Else MsgBox "Now opening:" & vbCr & fileToOpen End If '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 .Visible = True 'Can be false 'Open the document Set objDoc = .Documents.Open(fileToOpen, AddToRecentFiles:=False) With objDoc Set wdRng = .Bookmarks(StrBkMkNm).Range With wdRng If .Information(wdWithInTable) = True Then If .End = .Cells(1).End Then .End = .End - 1 End If .Text = vbNullString End With .Fields.Add Range:=.Bookmarks(StrBkMkNm).Range, Type:=wdFieldEmpty, Text:="REF MyReference \*Charformat", PreserveFormatting:=False .Bookmarks.Add Range:=wdRng, Name:=StrBkMkNm End With End With 'Clean up Set wdRng = Nothing: Set objDoc = Nothing: Set objWord = Nothing End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Problem SOLVED!
I bow to thee!
I am so very happy that you solved my problem . Regards, Vance |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Open header to insert text into bookmark | Amapola188 | Word VBA | 3 | 07-12-2012 05:16 PM |
Excel Pivot Table Calculated Field | BertLady | Excel | 0 | 05-21-2012 10:51 AM |
Late Binding on SHDocVw | tinfanide | Excel Programming | 1 | 05-19-2012 10:00 PM |
Putting a bookmark on a REF field in the selection | b0x4it | Word VBA | 4 | 05-26-2011 01:14 AM |
Highlight and put bookmark on the closest field to the cursor | b0x4it | Word VBA | 11 | 05-19-2011 11:15 PM |