复制和粘贴包括书签 VBA
Copy and paste INCLUDING bookmarks VBA
我有一个 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
首先尝试使用 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
行,您会看到书签最终出现在第二个添加的文本部分中,因为在创建第二部分时不再有重复的书签。
所以简而言之,复制书签不会在粘贴时复制书签,因此您需要确保删除原始书签或重命名书签以使其再次具有唯一性。重复是不行的。
我有一个 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
首先尝试使用 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
行,您会看到书签最终出现在第二个添加的文本部分中,因为在创建第二部分时不再有重复的书签。
所以简而言之,复制书签不会在粘贴时复制书签,因此您需要确保删除原始书签或重命名书签以使其再次具有唯一性。重复是不行的。