复制和粘贴包括书签 VBA

Question

我有一个 Excel 作品sheet，我试图将其中的信息粘贴到一个 word 文件 "Template"（只是我想要的布局中的一个 word 文档），其中包含书签。我想做的是：

复制word文档中的所有内容（包括书签）
用我sheet
转到页面底部，插入分页符并粘贴复制的文本，包括书签
对我的 excel 文件中的所有行循环第 2 点和第 3 点

我已经拼凑了一些代码，但我无法获得书签来粘贴文本，而书签仍然完好无损。你们中的任何人都可以帮助我到达那里吗？

Sub ReplaceBookmarks

'Select template
PickFolder = "C:\Users\Folder"   
Set fdn = Application.FileDialog(msoFileDialogFilePicker)
With fdn
    .AllowMultiSelect = False
    .Title = "Please select the file containing the Template"
    .Filters.Clear
    .InitialFileName = PickFolder
    If .Show = True Then
    Temp = fdn.SelectedItems(1)
    End If
End With

'open the word document
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(Temp)
'show the word document - put outside of loop for speed later
wdApp.Visible = True

'Copy everything in word document    
    wdDoc.Application.Selection.Wholestory
    wdDoc.Application.Selection.Copy

LastRow2 = 110    ' In real code this is counted on the sheet
For i = 2 To LastRow2      
'Data that will replace bookmarks in ws2 (defined somewhere in real code)
    Rf1 = ws2.Cells(i, 4).Value
    Rf2 = ws2.Cells(i, 2).Value
    Rf3 = ws2.Cells(i, 3).Value

'replace the bookmarks with the variables - references sub "Fillbookmark"
FillBookmark wdDoc, Rf1, "Rf1"
FillBookmark wdDoc, Rf2, "Rf2"
FillBookmark wdDoc, Rf3, "Rf3"

' Jump to bottom of document, add page break and paste
With wdDoc
.Application.Selection.EndKey Unit:=wdStory
.Application.Selection.InsertBreak Type:=wdPageBreak
.Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
Next i
End Sub

Sub FillBookmark(ByRef wdDoc As Object, _
ByVal vValue As Variant, _
ByVal sBmName As String, _
Optional sFormat As String)

Dim wdRng As Object

'store the bookmarks range
Set wdRng = wdDoc.Bookmarks(sBmName).Range
'if the optional format wasn’t supplied
If Len(sFormat) = 0 Then
'replace the bookmark text
   wdRng.Text = vValue
Else
'replace the bookmark text with formatted text
   wdRng.Text = Format(vValue, sFormat)
End If 
End Sub

Answer 1

首先尝试使用 WordOpenXml，而不是 Copy/Paste。这比copy/paste靠谱多了。现在请记住，书签是一个命名位置，当您复制文档的一部分并将其放回另一个位置时，原始书签仍在原处，新部分将不会获得复制的书签。

我将提供一些代码来向您展示：

Sub Test()

   ActiveDocument.Bookmarks.Add Name:="BM1", Range:=ActiveDocument.Paragraphs(1).Range

   ActiveDocument.Application.Selection.WholeStory

   Dim openxml As String
   openxml = ActiveDocument.Application.Selection.wordopenxml

   ActiveDocument.Bookmarks(1).Delete

   With ActiveDocument
      .Application.Selection.EndKey Unit:=wdStory
      .Application.Selection.InsertBreak Type:=wdPageBreak
      .Application.Selection.InsertXML xml:=openxml
   End With

'      ActiveDocument.Bookmarks(1).Delete

   With ActiveDocument
      .Application.Selection.EndKey Unit:=wdStory
      .Application.Selection.InsertBreak Type:=wdPageBreak
      .Application.Selection.InsertXML xml:=openxml
   End With
End Sub

现在打开一个新文档，在文档中输入 =Rand() 作为文本，然后按回车键输入一些文本接下来运行来自测试宏的代码。

您会看到，因为您使用 ActiveDocument.Bookmarks(1).Delete 从原始部分删除了书签，所以第一个插入的文本现在包含书签，而第二个则没有。

如果取消注释 ' ActiveDocument.Bookmarks(1).Delete 行，您会看到书签最终出现在第二个添加的文本部分中，因为在创建第二部分时不再有重复的书签。

所以简而言之，复制书签不会在粘贴时复制书签，因此您需要确保删除原始书签或重命名书签以使其再次具有唯一性。重复是不行的。

复制和粘贴包括书签 VBA

Copy and paste INCLUDING bookmarks VBA

vba

excel

ms-word

bookmarks