Vba Excel 到 word 实例

•  准备

Excel sheet 名字为 数据源 、sheet2

Word 模板：名字：模板.docx    里面包含一个模板表格

• 程序流程

1、打开模板文档、复制模板表格到剪贴板、关闭模板文档

2、创建新的文档、粘贴

3、使用数据源修改新文档的第一个表格、复制粘贴

4、删除第一个表格

5、另存为word

 

Public DataMaxRow


 Sub ToWord()
    模板路径 = ThisWorkbook.Path & "\" & "模板.docx"
    If Dir(模板路径, 16) = Empty Then
        Direrror = MsgBox("模板不存在！", vbDefaultButton1, "错误！")
        Exit Sub
    End If
    当前路径 = ThisWorkbook.Path
 
    Sheets("sheet2").Range("i11") = "正在打开Word主程序" '显示状态
 
    Set Word对象 = CreateObject("Word.Application")
 
    Sheets("sheet2").Range("i11") = "正在打开模板.docx" '显示状态

    With Word对象
        .Visible = False
        .Documents.Open 模板路径 '打开一个word文档


         Set 模板 = .ActiveDocument
         Set obj模板表格 = 模板.Tables(1) '这是个对象 可以使用table方法
         Let 模板表格内容 = obj模板表格 '这是个变量 let可以省略 表格内容指针
         
         Sheets("sheet2").Range("i11") = "正在新建文档" '显示状态
         
         Set newobj = .Documents.Add '新建一个word文档
    End With
    模板表格内容.Copy '将表格复制到剪贴板
    模板.Close '关闭模板
    Sheets("sheet2").Range("i11") = "正在生成word文档..." '显示状态
    With newobj
        .ActiveWindow.Selection.EndKey        '光标置于文件尾部
        .ActiveWindow.Selection.InsertBreak Type:=6 '换行
        .ActiveWindow.Selection.Paste '粘贴模板表格
        Set obj模板表格 = .Tables(1) '这是个对象 可以使用table方法
        Let 模板表格内容 = obj模板表格 '这是个变量 let可以省略 表格内容指针
    End With
    
    
    Sheets("sheet2").Range("i16") = 0
    Sheets("sheet2").Range("j16") = DataMaxRow
    For i = 2 To DataMaxRow '最后行号
        Sheets("sheet2").Range("k16") = i

        '填写表格数据 start
        
        obj模板表格.Cell(2, 2).Range = Sheets("数据源").Cells(i, 1)
        obj模板表格.Cell(3, 2).Range = Sheets("数据源").Cells(i, 2)
        obj模板表格.Cell(4, 2).Range = Sheets("数据源").Cells(i, 3)
        obj模板表格.Cell(5, 2).Range = Sheets("数据源").Cells(i, 4)
        obj模板表格.Cell(6, 2).Range = Sheets("数据源").Cells(i, 5)
        obj模板表格.Cell(7, 2).Range = Sheets("数据源").Cells(i, 6)
        obj模板表格.Cell(8, 2).Range = Sheets("数据源").Cells(i, 7)
        obj模板表格.Cell(9, 1).Range = Sheets("数据源").Cells(i, 8)

        '填写表格数据 end
               
        模板表格内容.Copy
        newobj.ActiveWindow.Selection.EndKey '光标置于文件尾部
        newobj.ActiveWindow.Selection.InsertBreak Type:=6 '6换行 7是分页
        newobj.ActiveWindow.Selection.Paste '粘贴模板表格
        Sheets("sheet2").Range("i16") = i / DataMaxRow * 1#
        
    Next i
   obj模板表格.Delete '删除复制过来的模板表格
   
    '另存为
    newobj.SaveAs2 Filename:=ThisWorkbook.Path & "\" & "模板1.docx"
    newobj.Close
    Word对象.Quit
    Set Word对象 = Nothing
    hh = MsgBox("已输出到 Word 文件！", vbInformation, "提示：")
 End Sub

Private Sub 导入N行到word_Click()
    DataMaxRow = Sheets("sheet2").Range("i9") + 1  '计算数据的行数 ActiveSheet
    OK_Cancel = MsgBox("是否输出 " & DataMaxRow & " 行数据到 Word 文件！", vbOKCancel, "提示：")
    If (OK_Cancel = vbOK) Then
        ToWord
    End If
End Sub

Private Sub 导入到word_Click()
    DataMaxRow = Sheets("数据源").[A65536].End(xlUp).Row '计算数据的行数 ActiveSheet
    OK_Cancel = MsgBox("是否输出 " & DataMaxRow & " 行数据到 Word 文件！", vbOKCancel, "提示：")
    If (OK_Cancel = vbOK) Then
        ToWord
    End If
End Sub