使用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