Word VBA - 在新文档中复制粘贴图像标题答案

【问题标题】：Word VBA - CopyPaste Image-header in a new DocumentWord VBA - 在新文档中复制粘贴图像标题
【发布时间】：2021-08-12 12:12:41
【问题描述】：

我有一个将指定表格复制到新文档中的功能，但我不知道如何导出作为图像的页眉，并将其设置为文档页面的页眉。

表格是根据组合框的实际值（ProjectsList.Value）来选择的，它指的是书签和其中包含的表格已成功复制粘贴到新文档中

对于每个粘贴的页面，我也想复制页眉。

我将在其中集成标题部分的函数：

Sub CopyPaste()
Dim Source As Document
Dim Target As Document
Dim tbl As Table
Dim tr As Range
Dim hRange As Word.Range

Set Source = ActiveDocument
Set Target = Documents.Add
Target.SaveAs FileName:=ProjectsList.Value

For Each tbl In Source.Bookmarks(ProjectsList.Value).Range.Tables
    Set tr = Target.Range
    tr.Collapse wdCollapseEnd
    tr.FormattedText = tbl.Range.FormattedText
    tr.Collapse wdCollapseEnd
    tr.Text = vbCrLf
Next

End Sub

【问题讨论】：

标签： vba ms-word header ms-office bookmarks

【解决方案1】：

例如：

Sub Replicate()
Application.ScreenUpdating = False
Dim Source As Document, Target As Document
Dim Tbl As Table, HdFt As HeaderFooter, Rng As Range
Set Source = ActiveDocument: Set Target = Documents.Add
With Target
    For Each Tbl In Source.Bookmarks(ProjectsList.Value).Range.Tables
        Set Rng = .Range.Characters.Last
        Rng.FormattedText = Tbl.Range.FormattedText
        Rng.InsertAfter vbCr
    Next
    For Each HdFt In Source.Sections.First.Headers
        With HdFt
            Set Rng = Target.Sections.First.Headers(.Index).Range
            Rng.FormattedText = .Range.FormattedText
            Rng.Characters.Last.Delete
        End With
    Next
    .SaveAs FileName:=ProjectsList.Value
End With
Application.ScreenUpdating = True
End Sub

【讨论】：