复制并粘贴包括书签的VBA

我有一个Excel工作表，我正在试图将信息粘贴到一个wordfile文件“模板”（只是在我想要的布局文件），其中包含书签。 我想要做的是：

1. 复制word文档中的所有内容（包括书签）
2. 将书签replace为我的工作表中的数据
3. 转到页面底部，插入一个分页符并粘贴复制的文本，包括书签
4. 循环通过点2和3为我的Excel文件中的所有行

我已经将一些代码修补到一起，但是我无法获取书签，粘贴书签的文本仍然完好无损。 你们能帮助我吗？

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。 这比复制/粘贴更可靠。 现在请记住，书签是一个命名的位置，当您复制文档的某个部分，并在原始书签仍然存在的情况下将其放回另一个位置时，新部分将不会获取复制的书签。

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

 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 

现在打开一个新的文档，在文档中input=Rand()作为文本input一些文本，然后按Enter键从Testmacros运行代码。

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

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

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