批量打印的VBA程序

1、批量打印的VBA程序一项任务的要求是把表1按照表2填写完整后，打印输出。如果人多的话，这项工作很是繁琐，所以我写了一个VBA程序，让工作自动进行。后来，这个程序的思路还发表的论文。Option ExplicitDim Arr()     '定义要打印的记录的行号为可变数组，用来保存要打印的记录的行号Dim LastRow%, PrePage%, FindNameRow%  '定义数据表中的最后一行行号、向导在第二步时的页面、找到的姓名所在的行Dim OutToPrint As Boolean 

2、60;   '定义是否输出到打印机Private Sub CBcancel_Click()    Unload MeEnd SubPrivate Sub CBfinish_Click()    Dim i%, j%    Dim myadd()    UFPrint.Hide    myadd = Array("C2", "E2&

3、quot;, "G2", "C3", "E3", "G3", "C4", "C5", "F5", "C6", "C7", "E7", "C8", "E8", "C9", "E9", "G9", "C10", "E10", "G10", &q

4、uot;B11")    '   定义需输入内容的单元格地址为数组    For i = LBound(Arr) To UBound(Arr)          ' 循环提取数据表中需要处理的记录        For j = LBound(myadd) To UBound(myad

5、d)     ' 循环提取各字段数据            Sheets("print").Range(myadd(j).Value = Sheets("data").Cells(Arr(i), j + 1).Value            '

6、0; 将数据填入到表格中        Next j        If OutToPrint Then Sheets("print").PrintOut       ' 打印        If Not OutToPrint Then Sheets(

7、"print").PrintPreview    '打印预览        DoEvents    Next    UFPrint.MultiPage1.Value = 0    '到第一个页面    UFPrint.ShowEnd SubPrivate Sub CBnext_Cli

8、ck()    Dim i%, SelCount%, MyCount%, ChangePage%    Select Case MultiPage1.Value   '判断按下“下一步”按钮时的页面    Case 0    '第一个页面        If OptionButton1.Value = True

9、Then ChangePage = 1        If OptionButton2.Value = True Then ChangePage = 2        If OptionButton3.Value = True Then ChangePage = 3        '根据所做的选择，分别设置将要跳到哪一个页面  &

10、#160; Case 1    '第二个页面        If Val(TextBox1) < 2 Or Val(TextBox1) > LastRow Or Val(TextBox2) < 2 Or Val(TextBox2) > LastRow Then            MsgBox "数值应大

11、于等于2，小于等于" & LastRow, vbOKOnly + vbExclamation, "提示"            TextBox1 = 2            TextBox2 = 2          &

12、#160; Exit Sub        End If        '如果数据不符合要求，退出过程        ReDim Arr(CInt(TextBox1) To CInt(TextBox2)    '重新定义数组      

13、;  For i = LBound(Arr) To UBound(Arr)            Arr(i) = i        Next i        '将数据写入数组        ChangePag

14、e = 4   '设置要转到的下一个页面    Case 2     '第三个页面        SelCount = 0        For i = 0 To ListBox1.ListCount - 1        

15、    If ListBox1.Selected(i) Then SelCount = SelCount + 1        Next i        '得到共有多少条记录被选择        ReDim Arr(1 To SelCount)   '重新定义数组

16、0;       MyCount = 1        For i = 0 To ListBox1.ListCount - 1            If ListBox1.Selected(i) Then          &#

17、160;     Arr(MyCount) = CInt(ListBox1.List(i, 0)                MyCount = MyCount + 1            End If     &#

18、160;  Next i        '将数据写入数组        ChangePage = 4   '设置要转到的下一个页面    Case 3   '第四个页面        Call CommandButt

19、on2_Click    '调用“查找”，确定能否找到记录        If FindNameRow = 0 Then  '不能找到记录            MsgBox "找不到姓名为<" & TextBox3 & ">的记录，<下一步>按钮不起作

20、用!", vbOKOnly + vbExclamation, "错误提示"            Exit Sub    '退出过程        End If        ReDim Arr(1 To 1)  

21、0;'重新定义数组        Arr(1) = FindNameRow        ChangePage = 4    '设置要转到的下一个页面    End Select    MultiPage1.Value = ChangePage    '切

22、换页面End SubPrivate Sub CBpre_Click()    Dim ChangePage%    Select Case MultiPage1.Value    Case 1, 2, 3        ChangePage = 0    Case 4       

23、0;ChangePage = PrePage   '读取前一页的信息    End Select    MultiPage1.Value = ChangePageEnd SubPrivate Sub CommandButton2_Click()    Dim i%    FindNameRow = 0    For i = 2 To LastRow 

24、       If Sheets("data").Cells(i, 1) = TextBox3.Text Then            FindNameRow = i            Exit For     &

25、#160;  End If    Next i    If FindNameRow = 0 Then        Label9.Caption = "未找到记录，请修改姓名后再试"        CBnext.Enabled = False    Else  

26、;      Label9.Caption = "可以找到记录，请继续下一步"        CBnext.Enabled = True    End IfEnd SubPrivate Sub MultiPage1_Change()    Dim i%    Dim MyStep$   &

27、#160;Select Case MultiPage1.Value    Case 0        CBpre.Enabled = False        CBnext.Enabled = True        CBfinish.Enabled = False    

28、60;   MyStep = "一"    Case 1        CBpre.Enabled = True        CBnext.Enabled = True        CBfinish.Enabled = False   

29、     PrePage = 1        MyStep = "二"    Case 2        '重新加载listbox1中的数据        ListBox1.Clear   '清除列表框

30、中的原有内容        For i = 2 To LastRow            ListBox1.AddItem i            ListBox1.List(i - 2, 1) = Sheets("data").Cells(i, 1)&#

31、160; '在列表框的第二列中添加姓名        Next i        ListBox1.Selected(0) = True    '将第一条记录设置为选择状态        CBpre.Enabled = True     

32、60;  CBnext.Enabled = True        CBfinish.Enabled = False        PrePage = 2        MyStep = "二"    Case 3     

33、60;  CBnext.Enabled = IIf(Left(Label9.Caption, 1) = "可", True, False)        CBpre.Enabled = True        CBfinish.Enabled = False        PrePage = 3  

34、      MyStep = "二"    Case 4        CBpre.Enabled = True        CBnext.Enabled = False        CBfinish.Enabled = True

35、60;       MyStep = "三"    End Select    UFPrint.Caption = "批量打印信息收集向导-第" & MyStep & "步，共三步"    '更改窗体的题目End SubPrivate Sub OptionButton4_Click()    OutToPrint = FalseEnd SubPrivate Sub OptionButton5_Click()    OutToPrint = TrueEnd SubPrivate Sub S