批量打印的VBA程序.doc

批量打印的VBA程序一项任务的要求是把表1按照表2填写完整后，打印输出。如果人多的话，这项工作很是繁琐，所以我写了一个VBA程序，让工作自动进行。后来，这个程序的思路还发表的论文。Option ExplicitDim Arr()定义要打印的记录的行号为可变数组，用来保存要打印的记录的行号Dim LastRow%, PrePage%, FindNameRow%定义数据表中的最后一行行号、向导在第二步时的页面、找到的姓名所在的行Dim OutToPrint As Boolean定义是否输出到打印机Private Sub CBcancel_Click()Unload MeEnd SubPrivate Sub CBfinish_Click()Dim i%, j%Dim myadd()UFPrint.Hidemyadd = Array(C2, E2, G2, C3, E3, G3, C4, C5, F5, C6, C7, E7, C8, E8, C9, E9, G9, C10, E10, G10, B11)定义需输入内容的单元格地址为数组For i = LBound(Arr) To UBound(Arr) 循环提取数据表中需要处理的记录For j = LBound(myadd) To UBound(myadd) 循环提取各字段数据Sheets(print).Range(myadd(j).Value = Sheets(data).Cells(Arr(i), j + 1).Value将数据填入到表格中Next jIf OutToPrint Then Sheets(print).PrintOut 打印If Not OutToPrint Then Sheets(print).PrintPreview打印预览DoEventsNextUFPrint.MultiPage1.Value = 0到第一个页面UFPrint.ShowEnd SubPrivate Sub CBnext_Click()Dim i%, SelCount%, MyCount%, ChangePage%Select Case MultiPage1.Value判断按下“下一步”按钮时的页面Case 0第一个页面If OptionButton1.Value = True Then ChangePage = 1If OptionButton2.Value = True Then ChangePage = 2If OptionButton3.Value = True Then ChangePage = 3根据所做的选择，分别设置将要跳到哪一个页面Case 1第二个页面If Val(TextBox1) LastRow Or Val(TextBox2) LastRow ThenMsgBox 数值应大于等于2，小于等于 & LastRow, vbOKOnly + vbExclamation, 提示TextBox1 = 2TextBox2 = 2Exit SubEnd If如果数据不符合要求，退出过程ReDim Arr(CInt(TextBox1) To CInt(TextBox2)重新定义数组For i = LBound(Arr) To UBound(Arr)Arr(i) = iNext i将数据写入数组ChangePage = 4设置要转到的下一个页面Case 2第三个页面SelCount = 0For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) Then SelCount = SelCount + 1Next i得到共有多少条记录被选择ReDim Arr(1 To SelCount)重新定义数组MyCount = 1For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) ThenArr(MyCount) = CInt(ListBox1.List(i, 0)MyCount = MyCount + 1End IfNext i将数据写入数组ChangePage = 4设置要转到的下一个页面Case 3第四个页面Call CommandButton2_Click调用“查找”，确定能否找到记录If FindNameRow = 0 Then不能找到记录MsgBox 找不到姓名为的记录，按钮不起作用!, vbOKOnly + vbExclamation, 错误提示Exit Sub退出过程End IfReDim Arr(1 To 1)重新定义数组Arr(1) = FindNameRowChangePage = 4设置要转到的下一个页面End SelectMultiPage1.Value = ChangePage切换页面End SubPrivate Sub CBpre_Click()Dim ChangePage%Select Case MultiPage1.ValueCase 1, 2, 3ChangePage = 0Case 4ChangePage = PrePage读取前一页的信息End SelectMultiPage1.Value = ChangePageEnd SubPrivate Sub CommandButton2_Click()Dim i%FindNameRow = 0For i = 2 To LastRowIf Sheets(data).Cells(i, 1) = TextBox3.Text ThenFindNameRow = iExit ForEnd IfNext iIf FindNameRow = 0 ThenLabel9.Caption = 未找到记录，请修改姓名后再试CBnext.Enabled = FalseElseLabel9.Caption = 可以找到记录，请继续下一步CBnext.Enabled = TrueEnd IfEnd SubPrivate Sub MultiPage1_Change()Dim i%Dim MyStep$Select Case MultiPage1.ValueCase 0CBpre.Enabled = FalseCBnext.Enabled = TrueCBfinish.Enabled = FalseMyStep = 一Case 1CBpre.Enabled = TrueCBnext.Enabled = TrueCBfinish.Enabled = FalsePrePage = 1MyStep = 二Case 2重新加载listbox1中的数据ListBox1.Clear清除列表框中的原有内容For i = 2 To LastRowListBox1.AddItem iListBox1.List(i - 2, 1) = Sheets(data).Cells(i, 1)在列表框的第二列中添加姓名Next iListBox1.Selected(0) = True将第一条记录设置为选择状态CBpre.Enabled = TrueCBnext.Enabled = TrueCBfinish.Enabled = FalsePrePage = 2MyStep = 二Case 3CBnext.Enabled = IIf(Left(Label9.Caption, 1) = 可, True, False)CBpre.Enabled = TrueCBfinish.Enabled = FalsePrePage = 3MyStep = 二Case 4CBpre.Enabled = TrueCBnext.Enabled = FalseCBfinish.Enabled = TrueMyStep = 三End SelectUFPrint.Caption = 批量打印信息收集向导-第 & MyStep & 步，共三步更改窗体的题目End SubPrivate Sub OptionButton4_Click()OutToPrint = FalseEnd SubPrivate Sub OptionButton5_Click()OutToPrint = TrueEnd SubPrivate Sub SpinButton1_Change()TextBox1.Text = SpinButton1.ValueEnd SubPrivate Sub SpinButton2_Change()TextBox2.Text = SpinButton2.ValueEnd SubPrivate Sub UserForm_Initialize()LastRow = Sheets(data).Range(A65536).End(xlUp).Row获得数据表中的记录数MultiPage1.Style = fmTabStyleNone将页面标签设置为无MultiPage1.Value = 0设置第一个页面打开CBfinish.Enab