批量打印的VBA程序

1、批量打印的VBA程序一項(xiàng)任務(wù)的要求是把表1按照表2填寫完整后，打印輸出。如果人多的話，這項(xiàng)工作很是繁瑣，所以我寫了一個VBA程序，讓工作自動進(jìn)行。后來，這個程序的思路還發(fā)表的論文。Option ExplicitDim Arr()     '定義要打印的記錄的行號為可變數(shù)組，用來保存要打印的記錄的行號Dim LastRow%, PrePage%, FindNameRow%  '定義數(shù)據(jù)表中的最后一行行號、向?qū)г诘诙綍r的頁面、找到的姓名所在的行Dim OutToPrint As Boolean 

2、60;   '定義是否輸出到打印機(jī)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")    '   定義需輸入內(nèi)容的單元格地址為數(shù)組    For i = LBound(Arr) To UBound(Arr)          ' 循環(huán)提取數(shù)據(jù)表中需要處理的記錄        For j = LBound(myadd) To UBound(myad

5、d)     ' 循環(huán)提取各字段數(shù)據(jù)            Sheets("print").Range(myadd(j).Value = Sheets("data").Cells(Arr(i), j + 1).Value            '

6、0; 將數(shù)據(jù)填入到表格中        Next j        If OutToPrint Then Sheets("print").PrintOut       ' 打印        If Not OutToPrint Then Sheets(

7、"print").PrintPreview    '打印預(yù)覽        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        '根據(jù)所做的選擇，分別設(shè)置將要跳到哪一個頁面  &

10、#160; Case 1    '第二個頁面        If Val(TextBox1) < 2 Or Val(TextBox1) > LastRow Or Val(TextBox2) < 2 Or Val(TextBox2) > LastRow Then            MsgBox "數(shù)值應(yīng)大

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

12、#160; Exit Sub        End If        '如果數(shù)據(jù)不符合要求，退出過程        ReDim Arr(CInt(TextBox1) To CInt(TextBox2)    '重新定義數(shù)組      

13、;  For i = LBound(Arr) To UBound(Arr)            Arr(i) = i        Next i        '將數(shù)據(jù)寫入數(shù)組        ChangePag

14、e = 4   '設(shè)置要轉(zhuǎn)到的下一個頁面    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)   '重新定義數(shù)組

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        '將數(shù)據(jù)寫入數(shù)組        ChangePage = 4   '設(shè)置要轉(zhuǎn)到的下一個頁面    Case 3   '第四個頁面        Call CommandButt

19、on2_Click    '調(diào)用“查找”，確定能否找到記錄        If FindNameRow = 0 Then  '不能找到記錄            MsgBox "找不到姓名為<" & TextBox3 & ">的記錄，<下一步>按鈕不起作

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

21、0;'重新定義數(shù)組        Arr(1) = FindNameRow        ChangePage = 4    '設(shè)置要轉(zhuǎn)到的下一個頁面    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 = "可以找到記錄，請繼續(xù)下一步"        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中的數(shù)據(jù)        ListBox1.Clear   '清除列表框

30、中的原有內(nèi)容        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    '將第一條記錄設(shè)置為選擇狀態(tài)        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 = "批量打印信息收集向?qū)?第" & MyStep & "步，共三步"    '更改窗體的題目End SubPrivate Sub OptionButton4_Click()    OutToPrint = FalseEnd SubPrivate Sub OptionButton5_Click()    OutToPrint = TrueEnd SubPrivate Sub S