複製並粘貼包括書籤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行，您將看到書籤在第二個添加的文本部分中結束，因爲在創建第二個部分時不再有重複的書籤。

因此，簡而言之，複製書籤不會在粘貼書籤時複製書籤，因此您需要確保刪除原始書籤或重命名書籤以使其再次具有唯一性。重複是不行的。