视频1 视频21 视频41 视频61 视频文章1 视频文章21 视频文章41 视频文章61 推荐1 推荐3 推荐5 推荐7 推荐9 推荐11 推荐13 推荐15 推荐17 推荐19 推荐21 推荐23 推荐25 推荐27 推荐29 推荐31 推荐33 推荐35 推荐37 推荐39 推荐41 推荐43 推荐45 推荐47 推荐49 关键词1 关键词101 关键词201 关键词301 关键词401 关键词501 关键词601 关键词701 关键词801 关键词901 关键词1001 关键词1101 关键词1201 关键词1301 关键词1401 关键词1501 关键词1601 关键词1701 关键词1801 关键词1901 视频扩展1 视频扩展6 视频扩展11 视频扩展16 文章1 文章201 文章401 文章601 文章801 文章1001 资讯1 资讯501 资讯1001 资讯1501 标签1 标签501 标签1001 关键词1 关键词501 关键词1001 关键词1501 专题2001
批量打印的VBA程序
2025-09-25 23:22:36 责编:小OO
文档
批量打印的VBA程序

一项任务的要求是把表1按照表2填写完整后,打印输出。如果人多的话,这项工作很是繁琐,所以我写了一个VBA程序,让工作自动进行。后来,这个程序的思路还发表的论文。

Option Explicit

Dim Arr()     '定义要打印的记录的行号为可变数组,用来保存要打印的记录的行号

Dim LastRow%, PrePage%, FindNameRow%  '定义数据表中的最后一行行号、向导在第二步时的页面、找到的姓名所在的行

Dim OutToPrint As Boolean     '定义是否输出到打印机

Private Sub CBcancel_Click()

    Unload Me

End Sub

Private Sub CBfinish_Click()

    Dim i%, j%

    Dim myadd()

    UFPrint.Hide

    myadd = 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 j

        If OutToPrint Then Sheets("print").PrintOut       ' 打印

        If Not OutToPrint Then Sheets("print").PrintPreview    '打印预览

        DoEvents

    Next

    UFPrint.MultiPage1.Value = 0    '到第一个页面

    UFPrint.Show

End Sub

Private Sub CBnext_Click()

    Dim i%, SelCount%, MyCount%, ChangePage%

    Select Case MultiPage1.Value   '判断按下“下一步”按钮时的页面

    Case 0    '第一个页面

        If OptionButton1.Value = True Then ChangePage = 1

        If OptionButton2.Value = True Then ChangePage = 2

        If OptionButton3.Value = True Then ChangePage = 3

        '根据所做的选择,分别设置将要跳到哪一个页面

    Case 1    '第二个页面

        If Val(TextBox1) < 2 Or Val(TextBox1) > LastRow Or Val(TextBox2) < 2 Or Val(TextBox2) > LastRow Then

            MsgBox "数值应大于等于2,小于等于" & LastRow, vbOKOnly + vbExclamation, "提示"

            TextBox1 = 2

            TextBox2 = 2

            Exit Sub

        End If

        '如果数据不符合要求,退出过程

        ReDim Arr(CInt(TextBox1) To CInt(TextBox2))    '重新定义数组

        For i = LBound(Arr) To UBound(Arr)

            Arr(i) = i

        Next i

        '将数据写入数组

        ChangePage = 4   '设置要转到的下一个页面

    Case 2     '第三个页面

        SelCount = 0

        For i = 0 To ListBox1.ListCount - 1

            If ListBox1.Selected(i) Then SelCount = SelCount + 1

        Next i

        '得到共有多少条记录被选择

        ReDim Arr(1 To SelCount)   '重新定义数组

        MyCount = 1

        For i = 0 To ListBox1.ListCount - 1

            If ListBox1.Selected(i) Then

                Arr(MyCount) = CInt(ListBox1.List(i, 0))

                MyCount = MyCount + 1

            End If

        Next i

        '将数据写入数组

        ChangePage = 4   '设置要转到的下一个页面

    Case 3   '第四个页面

        Call CommandButton2_Click    '调用“查找”,确定能否找到记录

        If FindNameRow = 0 Then  '不能找到记录

            MsgBox "找不到姓名为<" & TextBox3 & ">的记录,<下一步>按钮不起作用!", vbOKOnly + vbExclamation, "错误提示"

            Exit Sub    '退出过程

        End If

        ReDim Arr(1 To 1)   '重新定义数组

        Arr(1) = FindNameRow

        ChangePage = 4    '设置要转到的下一个页面

    End Select

    MultiPage1.Value = ChangePage    '切换页面

End Sub

Private Sub CBpre_Click()

    Dim ChangePage%

    Select Case MultiPage1.Value

    Case 1, 2, 3

        ChangePage = 0

    Case 4

        ChangePage = PrePage   '读取前一页的信息

    End Select

    MultiPage1.Value = ChangePage

End Sub

Private Sub CommandButton2_Click()

    Dim i%

    FindNameRow = 0

    For i = 2 To LastRow

        If Sheets("data").Cells(i, 1) = TextBox3.Text Then

            FindNameRow = i

            Exit For

        End If

    Next i

    If FindNameRow = 0 Then

        Label9.Caption = "未找到记录,请修改姓名后再试"

        CBnext.Enabled = False

    Else

        Label9.Caption = "可以找到记录,请继续下一步"

        CBnext.Enabled = True

    End If

End Sub

Private Sub MultiPage1_Change()

    Dim i%

    Dim MyStep$

    Select Case MultiPage1.Value

    Case 0

        CBpre.Enabled = False

        CBnext.Enabled = True

        CBfinish.Enabled = False

        MyStep = "一"

    Case 1

        CBpre.Enabled = True

        CBnext.Enabled = True

        CBfinish.Enabled = False

        PrePage = 1

        MyStep = "二"

    Case 2

        '重新加载listbox1中的数据

        ListBox1.Clear   '清除列表框中的原有内容

        For i = 2 To LastRow

            ListBox1.AddItem i

            ListBox1.List(i - 2, 1) = Sheets("data").Cells(i, 1)  '在列表框的第二列中添加姓名

        Next i

        ListBox1.Selected(0) = True    '将第一条记录设置为选择状态

        CBpre.Enabled = True

        CBnext.Enabled = True

        CBfinish.Enabled = False

        PrePage = 2

        MyStep = "二"

    Case 3

        CBnext.Enabled = IIf(Left(Label9.Caption, 1) = "可", True, False)

        CBpre.Enabled = True

        CBfinish.Enabled = False

        PrePage = 3

        MyStep = "二"

    Case 4

        CBpre.Enabled = True

        CBnext.Enabled = False

        CBfinish.Enabled = True

        MyStep = "三"

    End Select

    UFPrint.Caption = "批量打印信息收集向导---第" & MyStep & "步,共三步"    '更改窗体的题目

End Sub

Private Sub OptionButton4_Click()

    OutToPrint = False

End Sub

Private Sub OptionButton5_Click()

    OutToPrint = True

End Sub

Private Sub SpinButton1_Change()

    TextBox1.Text = SpinButton1.Value

End Sub

Private Sub SpinButton2_Change()

    TextBox2.Text = SpinButton2.Value

End Sub

Private Sub UserForm_Initialize()

    LastRow = Sheets("data").Range("A65536").End(xlUp).Row    '获得数据表中的记录数

    MultiPage1.Style = fmTabStyleNone               '将页面标签设置为无

    MultiPage1.Value = 0       '设置第一个页面打开

    CBfinish.Enabled = False      '禁用“完成”按钮

    CBpre.Enabled = False       '禁用“上一条”按钮

    OptionButton1.Value = True     '第一页上“连续的记录”被选中

    OptionButton4.Value = True     '第五页上“打印预览”被选中

    SpinButton1.Max = LastRow    '设置旋转按钮的最大值

    SpinButton2.Max = LastRow    '同上

End Sub下载本文

显示全文
专题