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

用VBA实现批量复制和打印任务

http://s15/mw690/49c182c2hd46874a138ae&690

http://s8/mw690/49c182c2hd468750c6427&690

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

http://s7/mw690/49c182c2hd46877bbd8b6&690

http://s1/mw690/49c182c2h7ba40c09c0d0&690

http://s7/mw690/49c182c2hd468790dbff6&690

http://s13/mw690/49c182c2hd46879b2036c&690