vbaで単語のブックマークを更新する

Question

次のプログラムは、単語テンプレートからレポートを生成しようとします。すでに存在する場合は、新しいレポートを生成するか、既存のレポートを開きます。このレポートでブックマークを更新できるようにしたいと思いますが、コピーされています。私はブックマークを複製して置き換える方法を説明したこのサイトの別のスレッドを見つけ、下のコードに挿入しました。コードはエラーなしで実行されていますが、ブックマークは更新されていないようです。 2番目のコードを実行するとコードが破損し、実行時エラー '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