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

使用vba更新word中的书签

1 个答案: