如何用VBA把EXCEL中的内容复制到WORD中

sha1972

请教各位老师，如何把EXCEL中的内容复制粘贴到指定纸张大小（A5纸）的WORD中，WORD中的表格要整体居中，并另存为同名的WORD文件。
     基本流程就是：选择EXCEL表格中A1:F30，复制。打开空白DOCX文档，粘贴。将DOCX文档另存为与EXCEL同名的文件，并关闭 DOCX。如附件中的效果，谢谢！

Gonzalez_Frank

Sub test()
Dim app As Object
Dim wb As Object
ThisDocument.Content.Delete
Set app = CreateObject("excel.application")
app.DisplayAlerts = False
Set wb = app.workbooks.Open(ThisDocument.Path & "\20240328普碘.xls")
wb.sheets(2).Range("a1:f30").Copy
ThisDocument.Range.Paste
wb.Close (False)
Set wb = Nothing
app.DisplayAlerts = True
Set app = Nothing
End Sub

mx27377

Sub Run()
    Application.ScreenUpdating = False
   
    'Word模板
    Set WordApp = CreateObject("Word.Application")
    TmpPath = ThisWorkbook.Path & "\模板.docx"
    Set TmpDoc = WordApp.Documents.Open(Filename:=TmpPath, ReadOnly:=True)
   
    'Excel数据表
    Set DataSht = ThisWorkbook.Sheets(1)
    DataLastRow = DataSht.Cells(Rows.Count, 1).End(xlUp).Row
    DataArr = DataSht.Range("A1:AE" & DataLastRow)
    DataCount = UBound(DataArr, 1)
   
    '登记表所在文件夹
    GenerateDir = ThisWorkbook.Path & "\合同生成文件夹"
   
    '循环遍历每条登记信息，生成对应的Word准考证
    For I = 2 To DataCount
        ' 将Word模板复制过来
        TmpDoc.Content.Copy
        Set NewDoc = WordApp.Documents.Add
        NewDoc.Content.Paste
        
        '往模板里填写登记信息
        With NewDoc
            .Bookmarks("原件编号").Range.Text = DataArr(I, 1)
         
        End With
        
        '保存并关闭新生成的Word文档
        NewDoc.SaveAs2 GenerateDir & "\" & "技术开发合同-" & DataArr(I, 2) & ".docx"
        NewDoc.Close
        
    Next I
   
    WordApp.Quit
   
    Application.ScreenUpdating = True

    MsgBox "合同生成完毕！"