插入文本之前,Excel VBA空嵌入的Word文档书签

时间:2019-01-21 14:35:57

标签: excel vba ms-word word-vba

我有Excel工作簿,我从中将数据插入到嵌入式(在我的工作簿中)Word文件。我有预定义的书签。我正在从Excel工作簿单元格中插入书签文本。除了从书签中删除导入的数据外,其他所有方法都工作正常。问题是我的代码经过几次运行后仍将数据记录到书签中。因此,例如,运行3次后,我得到了“ SwedenSwedenSweden”。

在插入数据objWord.Bookmarks.Item("Country").Range = ""似乎无效之前,我想使书签为空。使用此命令,我尝试在输入新书签之前和退出我的Template Word文档之后使书签为空。有什么好的解决方案吗?

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

1 个答案:

答案 0 :(得分:2)

将数据写入标记位置的书签(而不是包含内容)将产生您描述的结果。使其生效的方法是至少在第一次插入后使用包含内容的书签。写入此类书签时,在替换内容时会将其删除,因此也必须重新创建书签。例如:

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 

这将围绕新内容重新创建书签。无需删除内容/将其设置为“”,因为它将被替换。

我的建议是将其放在可以从主代码调用的单独过程中。传入objWord,书签名称和Excel Range或其数据。