Word VBA - CopyPaste图像-新文档中的页眉

Sub CopyPasteImageToHeader()
    Dim sourceDoc As Document
    Dim targetDoc As Document
    Dim headerRange As Range
    Dim imagePath As String
    
    ' 设置源文档和目标文档
    Set sourceDoc = ActiveDocument
    Set targetDoc = Documents.Add
    
    ' 设置页眉范围
    Set headerRange = targetDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    
    ' 设置图像路径
    imagePath = "C:\path\to\image.jpg"
    
    ' 复制图像到剪贴板
    sourceDoc.InlineShapes(1).Range.Copy
    
    ' 在页眉范围中粘贴图像
    headerRange.Paste
    
    ' 调整图像大小和位置
    With headerRange.InlineShapes(1)
        .LockAspectRatio = msoFalse
        .Width = 100
        .Height = 100
        .Top = headerRange.Paragraphs(1).Range.Information(wdVerticalPositionRelativeToPage)
    End With
    
    ' 保存目标文档
    targetDoc.SaveAs "C:\path\to\new_document.docx"
    
    ' 关闭目标文档
    targetDoc.Close
    
    ' 释放对象变量
    Set headerRange = Nothing
    Set targetDoc = Nothing
    Set sourceDoc = Nothing
End Sub