|
解决了,感谢大家,我把代码发上来
Private Sub 常规报告_Click()
DoCmd.RunCommand acCmdSaveRecord '打印前先保存记录
On Error GoTo Err_cmdExportToWord_Click
Dim objApp As Object 'Word.Application
Dim objDoc As Object 'Word.Document
Dim win As Object 'Word.窗口
Dim doc As Object
Dim docApp As Object
Dim strTemplates As String '模板文件路径名
Dim strFileName As String '将数据导出到此文件
If Me.NewRecord Then
MsgBox "当前没有可导出的数据。", vbInformation, "提示"
Exit Sub
End If
strTemplates = CurrentProject.Path & "\常规项目报告模板.dotx"
'通过文件对话框生成另存为文件名
With FileDialog(2) 'msoFileDialogSaveAs
.InitialFileName = CurrentProject.Path & "\常规项目报告模板.doc"
If .Show Then strFileName = .SelectedItems(1)
End With
'如果对话框被取消,则变量没有被赋值,退出过程
If strFileName = "" Then Exit Sub
'文件名必须包括“.doc”的文件扩展名,如没有则自动加上
If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"
'如果文件已存在,则删除已有文件
If Dir(strFileName) <> "" Then Kill strFileName
'将光标设置为沙漏形,以示正在执行程序
DoCmd.Hourglass True
'打开模板文件
Set objApp = CreateObject("Word.Application") 'createObject("类名")
objApp.Visible = True
Set objDoc = objApp.Documents.Open(strTemplates, , True)
Set win = objDoc.ActiveWindow
With win.Selection.Find '使用查找和替换
.Text = "[报告编号]"
.Replacement.Text = Nz(Me.报告编号)
.Execute , , , , , , , , , , 2 '全部替换
End With
'将写入数据的模板另存为文档文件
objDoc.SaveAs strFileName
objDoc.Saved = True
Exit_cmdExportToWord_Click:
If Not objDoc Is Nothing Then objApp.Visible = True
'恢复光标形状
DoCmd.Hourglass False
Set objApp = Nothing
Set objDoc = Nothing
Set objTable = Nothing
Exit Sub
Err_cmdExportToWord_Click:
MsgBox Err.Description, vbCritical, "出错"
Resume Exit_cmdExportToWord_Click
End Sub |
|