复制并粘贴包括书签VBA

Question

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

1. 所有内容复制word文档（包括书签）
2. 在我的片
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代替复制/粘贴。这比复制/粘贴更可靠。现在请记住，Bookmark是一个命名的位置，当您复制文档的某个部分并在原始书签仍在原处时将其放回到其他位置时，新部分将不会获取复制的书签。

我会提供的代码一点点地展示给你：

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行，您将看到书签在第二个添加的文本部分中结束，因为在创建第二个部分时不再有重复的书签。

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