如何在数据源中直接发送命令打印当前记录的邮件合并文档？

wuaza

一个邮件合并文档123.doc以abc.xls为数据源，现在当我在abc.xls中输入了一条新记录（第3条）后我想在当前的excel文件中做一个按钮，单击后实现打印（或预览）所关联的邮件合并文档123.doc，并且打印的正是新增的那条（第三条）记录？

以上功能类似于在数据库的窗体中打印报表的当前记录。我想通过excel、word来实现，只是一切操作最好都在excel数据源中进行，word的邮件合并只在后台进行。

[此贴子已经被作者于2005-7-24 21:46:15编辑过]

守柔

以下代码均为EXCEL中

Private Sub Worksheet_Change(ByVal Target As Range) '如果活动单元格位于B列并且行号>1 If Target.Column = 2 And Target.Row > 1 Then '提示 If MsgBox("您需要把当前记录打印到WORD吗?", vbYesNo + vbInformation + vbDefaultButton2) = vbNo Then Exit Sub '取得公用变量值 CurrentRow = Target.Offset(, -1).Value Call WordPrint End If End Sub '---------------------- Public CurrentRow As Long Sub WordPrint() '注意两点,一是引用MICROSOFT WORD 10.0 OBJECT LIBRARY '必须在XP及其以上版本中可以运行,WORD2000无合并到打印机命令 Dim WdApp As Word.Application, TF As Boolean, Doc As Word.Document On Error Resume Next '忽略错误 '返回到WORD对象的引用 Set WdApp = GetObject(, "Word.Application") '如果不存在WORD对象,则出错 If Err.Number <> 0 Then Err.Clear '清除错误 '创建对WORD对象的引用 Set WdApp = CreateObject("Word.Application") TF = True '赋值 End If '打开同一文档下的指定WORD文档 Set Doc = WdApp.Documents.Open(ThisWorkbook.Path & "\123.doc") With Doc.MailMerge '对于该文档的合并功能 '将首记录定为当行活动单元格所在记录号(A列) .DataSource.FirstRecord = CurrentRow '将尾记录定为当行活动单元格所在记录号(A列),就是打印当前记录 .DataSource.LastRecord = CurrentRow .Destination = wdSendToPrinter '发送到打印机 .SuppressBlankLines = True '删除空行(记录) .Execute End With Doc.Close False '关闭并不保存 '退出WORD程序(看TF值) If TF = True Then WdApp.Quit: Set WdApp = Nothing End Sub '----------------------

两个文件必需在同一文件夹中。

waAhEBHR.zip (18.78 KB, 下载次数: 83)

2005-7-25 07:24 上传

点击文件名下载附件
如何在数据源中直接发送命令打印当前记录的邮件合并文档？

wuaza

非常感谢守柔版主，一早就给出了这么好的答案。

我还没试用，还得研究一番。

wuaza

请问版主，如果想先打开word预览一下（而不是直接发送到打印机）的话，哪句代码需要改一下？又要麻烦你了。

从代码看好像word对象已经打开，可当我选择打印时word并没有打开，这是怎么回事啊？word文档隐藏了还是在后台打开了？选择打印时最好能同时打开已合并当前记录的word文档，以便修改、预览。

[此贴子已经被作者于2005-7-25 14:01:02编辑过]

wuaza

当我把忽略错误的代码去掉后发现了运行时错误，activex部件不能创建，按调试后停留在“ Set WdApp = GetObject(, "Word.Application")”这句上。

可“一是引用MICROSOFT WORD 10.0 OBJECT LIBRARY，必须在XP及其以上版本中可以运行,WORD2000无合并到打印机命令”都已经做到了呀！我的是office2003。

wuaza

再顶一下，版主可能很忙吧？或者这个问题实在很难搞清。

守柔

以下代码均在Excel中

Private Sub Worksheet_Change(ByVal Target As Range) '如果活动单元格位于B列并且行号>1 If Target.Column = 2 And Target.Row > 1 Then '提示 If MsgBox("您需要把当前记录打印到WORD吗?", vbYesNo + vbInformation + vbDefaultButton2) = vbNo Then Exit Sub '取得公用变量值 CurrentRow = Target.Offset(, -1).Value Call WordPrint End If End Sub

‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘

Option Explicit Public CurrentRow As Long Sub WordPrint() '注意两点,一是引用MICROSOFT WORD 10.0 OBJECT LIBRARY '必须在XP及其以上版本中可以运行,WORD2000无合并到打印机命令 Dim WdApp As Word.Application, TF As Boolean, Doc As Word.Document On Error Resume Next '忽略错误 '返回到WORD对象的引用 Set WdApp = GetObject(, "Word.Application") '如果不存在WORD对象,则出错 If Err.Number <> 0 Then Err.Clear '清除错误 '创建对WORD对象的引用 Set WdApp = CreateObject("Word.Application") TF = True '赋值 End If WdApp.Visible = True '显示WORD程序 '打开同一文档下的指定WORD文档 Set Doc = WdApp.Documents.Open(ThisWorkbook.Path & "\123.doc") With Doc.MailMerge '对于该文档的合并功能 '将首记录定为当行活动单元格所在记录号(A列) .DataSource.FirstRecord = CurrentRow '将尾记录定为当行活动单元格所在记录号(A列),就是打印当前记录 .DataSource.LastRecord = CurrentRow ' .Destination = wdSendToPrinter '发送到打印机 .Destination = wdSendToNewDocument .SuppressBlankLines = True '删除空行(记录) .Execute End With Doc.Close False '关闭并不保存 VBA.AppActivate WdApp.Name '激活WORD程序 WdApp.ActiveDocument.PrintPreview '预览 '退出WORD程序(看TF值) ' If TF = True Then WdApp.Quit: Set WdApp = Nothing End Sub '----------------------

此处不能的on error resume next是必需的，它是一个错误陷阱，以捕捉错误号！