Question

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

复制word文档中的所有内容（包括书签）
将书签替换为我的工作表中的数据
转到页面底部，插入分页符并粘贴复制的文本，包括书签
循环通过点2＆amp; 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

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

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

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

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

复制并粘贴包含书签VBA

1 个答案: