简体   繁体   中英

Excel VBA null embedded word document bookmarks before inserting text

I have Excel workbook from where I am inserting data to embedded (inside my workbook) Word file. I have predefined bookmarks. I am inserting bookmark text from Excel workbook cells. Everything works fine except for deleting imported data from bookmarks. The problem is that with my code, after several runs keeps recording data to bookmarks. So, for example, after 3 runs I have "SwedenSwedenSweden".

I would like to null bookmarks before inserting data objWord.Bookmarks.Item("Country").Range = "" does not seems to work. With this command I am trying to null bookmarks before entering new ones and after exiting my Template Word document. Any good solutions?

Sub testInsertBookmark()
Const wdFormatDocument = 0
Dim sh As Shape
Dim objWord As Object ''Word.Document
Dim objOLE As OLEObject
Dim wSystem As Worksheet
Dim BMRange As Range
On Error Resume Next

Set wSystem = Worksheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("Object 1")
''Activate the contents of the object
sh.OLEFormat.Activate
''The OLE Object contained
Set objOLE = sh.OLEFormat.Object
''This is the bit that took time
Set objWord = objOLE.Object

 objWord.Bookmarks.Item("Name").Range = ""
 objWord.Bookmarks.Item("Title").Range = ""
 objWord.Bookmarks.Item("Telephone").Range = ""
 objWord.Bookmarks.Item("Company").Range = ""
 objWord.Bookmarks.Item("Address").Range = ""
 objWord.Bookmarks.Item("Postcode").Range = ""
 objWord.Bookmarks.Item("City").Range = ""
 objWord.Bookmarks.Item("Country").Range = ""

 objWord.Bookmarks.Item("Name").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D5").Value
 objWord.Bookmarks.Item("Title").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D6").Value
 objWord.Bookmarks.Item("Telephone").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D7").Value
 objWord.Bookmarks.Item("Company").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D8").Value
 objWord.Bookmarks.Item("Address").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D9").Value
 objWord.Bookmarks.Item("Postcode").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D10").Value
 objWord.Bookmarks.Item("City").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D11").Value
 objWord.Bookmarks.Item("Country").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D12").Value

objWord.Application.Visible = True

''Easy enough
    objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & ", " & Sheets("Other Data").Range("AN7").Value & "_" & Sheets("Other Data").Range("AN8").Value & "_" & Sheets("Other Data").Range("AX10").Value & ".pdf", 17

 objWord.Bookmarks.Item("Name").Range = ""
 objWord.Bookmarks.Item("Title").Range = ""
 objWord.Bookmarks.Item("Telephone").Range = ""
 objWord.Bookmarks.Item("Company").Range = ""
 objWord.Bookmarks.Item("Address").Range = ""
 objWord.Bookmarks.Item("Postcode").Range = ""
 objWord.Bookmarks.Item("City").Range = ""
 objWord.Bookmarks.Item("Country").Range = ""

sh.OLEFormat.Delete

ThisWorkbook.Worksheets("MAIN").Activate

End Sub

Writing data to a bookmark that marks a position (rather than contains content) will yield the result you describe. The way to get this to work is to use a bookmark that contains content - at least after the first insertion. When writing to such a bookmark it is deleted when the content is replaced, so it's necessary to recreate the bookmark, as well. For example:

Dim wdRange as Object 'Word.Range
Set wdRange = objWord.Bookmarks.Item("Name").Range
wdRange.Text = ThisWorkbook.Sheets("MAIN").Range("D5").Value
objWord.Bookmarks.Add "Name", wdRange 

This recreates the bookmark around the new content. There's no need to delete the content / set it to "" as it will be replaced.

My suggestion would be to put this in a separate procedure that can be called from the main code. Pass in objWord, the bookmark name and the Excel Range or its data.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM