excel怎样自动生成word报告?
excel自动生成word报告的方法:
1、制作合同模板文件,把合同变量部分用特殊变量替换。图示如下:
2、在EXCEL里面添加合同主要内容数据,图示如下:
3、在EXCEL里面添加一个Active X按钮控件,根据自身需要修改其属性。
4、打开VBA编辑器,添加项目引用。
具体操作过程为:选择“工具”—“引用”,然后打开加载文件选择框,选择“Microsoft Word16.0 Object Library”这个项目,如下图:
在此,特别需要说明,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》