用VBA更新Word中的書簽

Question

以下程序嘗試從單詞模板生成報告。 它將生成一個新報告或打開一個現有報告（如果已經存在）。 我希望我的用戶能夠更新此報告中的書簽，但是它們已被復制。 我在該站點上找到了另一個線程，該線程討論了如何復制和替換書簽並將其插入下面的代碼中。 代碼正在運行，沒有任何錯誤，但書簽似乎沒有更新。 當我第二次在添加的文檔上運行代碼時，代碼中斷，並且出現運行時錯誤'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