求邮件合并中的打印次数限制

PDJ72

我有一邮件合并数据源是EXCEL,每一行数据源合并到WORD为一张纸,每次打印时不是一次全部打完,可能是先打第4条或第7条不定,如何设置每条记录只打印一次或显示出已打印的次数,即今天已打印了第4条记录,明天打开合并时再打印第4条记录时将予以限制不能打印或在合并中显示打印第2次

[此贴子已经被作者于2006-8-22 13:44:05编辑过]

c81

我不会VBA，我讨论一下行吗？

首先在Excel中在每个记录后添加一个数据：打印次数，整数，默认为0.

在第二张sheet后加个Word文档合并事件的记数（用WordVBA的邮件合并各种事件来判断记数）

用WordVBA的“DocumentBeforePrint”事件来根据上面的两种数据计算某记录打印了多少次，从而对某个记录成的一页能不能继续打印作出判断。

守柔

使用VBA可以很简单地解决楼主的问题，此方法为AUTOMATION方法，即在Excel中操控Word对象，请楼主上传WORD文档和EXCEL工作薄示例的附件，我们一起解决。

PDJ72

QUOTE:

以下是引用守柔在2006-8-23 11:21:02的发言：
使用VBA可以很简单地解决楼主的问题，此方法为AUTOMATION方法，即在Excel中操控Word对象，请楼主上传WORD文档和EXCEL工作薄示例的附件，我们一起解决。

见附件,先谢了

RJM2C7jx.rar (12.36 KB, 下载次数: 35)

2006-8-23 12:28 上传

点击文件名下载附件
求邮件合并中的打印次数限制

守柔

QUOTE:

以下是引用PDJ72在2006-8-24 13:05:11的发言：
顶一下,版主帮忙啊

把表格做好一点，做成数据库形式的表格，适当修改以下代码即可。

Sub PrinttoWord()
    Dim wdApp As New Word.Application, wdDoc As Word.Document, wdTable As Word.Table
    Dim wdPar As Word.Range, myRange As Range, PrintCount As Integer
    If ActiveCell.Column = 1 And ActiveCell.Row > 1 Then
        wdApp.Visible = True
        Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\汇款证明单.doc")
        Set wdTable = wdDoc.Tables(1)
        Set wdPar = wdDoc.Paragraphs(2).Range
        wdPar.SetRange wdPar.Start, wdPar.End - 1
        For Each myRange In Selection.Cells
            With myRange
                If Not .Comment Is Nothing Then
                    PrintCount = CInt(VBA.Replace(.Comment.Text, .Comment.Author & ":", ""))
                    If MsgBox(.Offset(, 3).Value & "ÒÑ´òÓ¡" & PrintCount & "次,是否继续打印该记录?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then GoTo GN
                    .Comment.Text Text:=Application.UserName & ":" & Chr(10) & PrintCount + 1
                Else
                    .AddComment Application.UserName & ":" & Chr(10) & "1"
                End If
                wdPar.Text = "                                   " & .Offset(, 8).Value & "                                合同编号:" & .Value & " "
            End With
            With wdTable
                .Cell(1, 2).Range.Text = myRange.Offset(, 1).Value
                .Cell(1, 4).Range.Text = myRange.Offset(, 3).Value
                .Cell(1, 6).Range.Text = myRange.Offset(, 13).Value
                .Cell(1, 8).Range.Text = myRange.Offset(, 14).Value
                .Cell(2, 2).Range.Text = myRange.Offset(, 15).Value
                .Cell(2, 4).Range.Text = myRange.Offset(, 5).Value
                .Cell(3, 2).Range.Text = myRange.Offset(, 4).Value
            End With
            wdDoc.PrintOut
GN:             Next
    End If
    wdDoc.Close False
    wdApp.Quit
    Set wdApp = Nothing
End Sub