用vba更新word中的书签

Question

以下程序尝试从 word 模板生成报告。如果它已经存在，它将生成一个新的报告或打开一个现有的报告。我希望我的用户能够更新此报告中的书签，但它们正在被复制。我在该站点上找到了另一个线程，该线程讨论了如何复制和替换书签并将其插入到下面的代码中。代码运行没有任何错误，但书签似乎没有更新。当我在添加的文档上第二次运行代码时，代码中断并且我得到运行时错误'462：远程服务器机器不存在或不可用并突出显示将值插入单词书签的第一行代码。我假设这是因为书签不再存在。我是一个真正的新手，所以也许它真的很简单。我感谢任何和所有的帮助。

Set wdApp = CreateObject("word.application")

FilePath = Application.ThisWorkbook.Path & "\" & "WriteUp Template " & ActiveSheet.Name & ".docx"

If Dir(FilePath) <> "" Then

With wdApp
.Visible = True
.Activate
.documents.Open Application.ThisWorkbook.Path & "\" & "WriteUp Template " & ActiveSheet.Name & ".docx"
End With
Else
With wdApp
.Visible = True
.Activate
.documents.Add Application.ThisWorkbook.Path & "\" & "WriteUp Template.docx"
End With
End If


 For Each xlName In Excel.ThisWorkbook.Names

'if xlName's name is existing in document then put the value in place of the bookmark
If wdApp.ActiveDocument.Bookmarks.Exists(xlName.Name) Then
    'Copy the Bookmark's Range.
    Set BMRange = wdApp.ActiveDocument.Bookmarks(xlName.Name).Range.Duplicate
    BMRange.Text = Range(xlName.Value)
    'Re-insert the bookmark
    wdApp.ActiveDocument.Bookmarks.Add xlName.Name, BMRange
End If

Next xlName



'Insert title of Company

Set CompanyTitle = Range("B1:B20").Find("Cash Flow", , , , , , False).Offset(0, 1)
wdApp.ActiveDocument.Bookmarks("CompanyTitleCF").Range = CompanyTitle.Value

Answer 1

未经测试但应该可以工作：

Sub Tester()

    Dim wdApp, FilePath, doc1 As Object, doc2 As Object, fldr As String
    Dim xlName, CompanyTitle As Range

    Set wdApp = CreateObject("word.application")
    wdApp.visisble = True

    fldr = ThisWorkbook.Path & "\"
    FilePath = fldr & "WriteUp Template " & ActiveSheet.Name & ".docx"

    '<tw>Best to assign each doc to a variable as you open it, so you can
    '   refer to it later instead of using "Activedocument"
    If Dir(FilePath) <> "" Then
        Set doc1 = wdApp.documents.Open(FilePath)
        Set doc2 = wdApp.documents.Open(fldr & "WriteUp Template.docx")
    End If

    For Each xlName In ThisWorkbook.Names
        'if xlName's name is existing in document then put the value in place of the bookmark
        ' <tw>Assume you mean to work with doc2 here...
        If doc2.Bookmarks.Exists(xlName.Name) Then
            SetBookmarkText doc2, xlName.Name, Range(xlName.Value) '<< call utility sub
        End If
    Next xlName

    'Insert title of Company
    Set CompanyTitle = Range("B1:B20").Find("Cash Flow", , , , , , False).Offset(0, 1)
    SetBookmarkText doc2, "CompanyTitleCF", CompanyTitle.Value

End Sub


'Replace the text in a bookmark or insert text into an empty (zero-length) bookmark
Sub SetBookmarkText(oDoc As Object, sBookmark As String, sText As String)
    Dim BMRange As Object
    If oDoc.Range.Bookmarks.Exists(sBookmark) Then
      Set BMRange = oDoc.Range.Bookmarks(sBookmark).Range
      BMRange.Text = sText
      oDoc.Range.Bookmarks.Add sBookmark, BMRange
    Else
      MsgBox "Bookmark '" & sBookmark & "' not found in document '" & oDoc.Name & "'" & _
              vbCrLf & "Content not updated"
    End If
End Sub