excel怎样自动生成word报告?

excel怎样自动生成word报告?

excel怎样自动生成word报告?

excel自动生成word报告的方法:

1、制作合同模板文件,把合同变量部分用特殊变量替换。图示如下:

excel怎样自动生成word报告?

2、在EXCEL里面添加合同主要内容数据,图示如下:

excel怎样自动生成word报告?

3、在EXCEL里面添加一个Active X按钮控件,根据自身需要修改其属性。

excel怎样自动生成word报告?

4、打开VBA编辑器,添加项目引用。

具体操作过程为:选择“工具”—“引用”,然后打开加载文件选择框,选择“microsoft Word16.0 Object Library”这个项目,如下图:

excel怎样自动生成word报告?

在此,特别需要说明,Word项目这个必须引用起来,否则后期在执行变量替换时,VBA无法调用Word替换功能。

5、在按钮控件下写如下代码,并将该EXCEL文件另存为XLSM:

 Private Sub cmd_makedoc_Click()On Error GoTo Err_cmdExportToWord_Click     Dim objApp As Object 'Word.Application    Dim objDoc As Object 'Word.Document    Dim strTemplates As String '模板文件路径名    Dim strFileName As String '将数据导出到此文件    Dim i As Integer     Dim contact_NO As String     Dim side_A As String     Dim side_B As String     i = ActiveCell.Row     contact_NO = Cells(i, 1)     side_A = Cells(i, 2)     side_B = Cells(i, 3)       With Application.FileDialog(msoFileDialogFilePicker)          .Filters.Add "word文件", "*.doc*", 1          .AllowMultiSelect = False          If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub     End With   '通过文件对话框生成另存为文件名    With Application.FileDialog(msoFileDialogSaveAs)         '.InitialFileName = CurrentProject.Path & "" & contact_NO & ".doc"        .InitialFileName = contact_NO & ".doc"         If .Show Then strFileName = .SelectedItems(1) Else Exit Sub     End With     '文件名必须包括“.doc”的文件扩展名,如没有则自动加上    If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"     '如果文件已存在,则删除已有文件    If Dir(strFileName)  "" Then Kill strFileName     '打开模板文件    Set objApp = CreateObject("Word.Application")     objApp.Visible = True     Set objDoc = objApp.Documents.Open(strTemplates, , False)     '开始替换模板预置变量文本   With objApp.Application.Selection         .Find.ClearFormatting         .Find.Replacement.ClearFormatting         With .Find              .Text = "{$合同编号}"              .Replacement.Text = contact_NO         End With         .Find.Execute Replace:=wdReplaceAll           With .Find              .Text = "{$甲方}"              .Replacement.Text = side_A         End With         .Find.Execute Replace:=wdReplaceAll          With .Find             .Text = "{$乙方}"             .Replacement.Text = side_B        End With        .Find.Execute Replace:=wdReplaceAll     End With       '将写入数据的模板另存为文档文件    objDoc.SaveAs strFileName     objDoc.Saved = True                 MsgBox "合同文本生成完毕!", vbYes + vbExclamationExit_cmdExportToWord_Click:     If Not objDoc Is Nothing Then objApp.Visible = True     Set objApp = Nothing     Set objDoc = Nothing     Set objTable = Nothing     Exit SubErr_cmdExportToWord_Click:     MsgBox Err.Description, vbCritical, "出错"     Resume Exit_cmdExportToWord_ClickEnd Sub

推荐教程:《excel

© 版权声明
THE END
喜欢就支持一下吧
点赞9 分享