内容提要
获奖证书打印完整代码1、在窗体Usf_Print里，定义变量
Dim p As IntegerDim DicUnit As Object, DicGender As Object, DicItem As ObjectDim iRow As Integer, iCol As IntegerDim tbTitle(), arr()Dim LvItem As ListItem
2、在窗体Usf_Print里，UserForm_Initialize窗体初始化
Private Sub UserForm_Initialize() On Error Resume Next Dim arrTemp() Dim dbs As String, tb As String Dim cnn As Object, rs As Object, strCnn As String Dim sql As String, sql2 As String Dim arrWidth() arrWidth = Array(40, 90, 50, 50, 40, 40, 50, 60, 50, 60, 60, 80) Me.BackColor = RGB(255, 153, 102) dbs = ThisWorkbook.FullName tb = "[学生成绩$]" Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " _ & dbs & ";Extended Properties='Excel 12.0 Xml;HDR=YES';" cnn.Open strCnn sql = "select * from " & tb & " order by 序号" rs.Open sql, cnn arr = rs.getrows For i = 0 To rs.Fields.Count - 1 ReDim Preserve tbTitle(k) tbTitle(k) = rs.Fields(i).Name k = k + 1 Next Set DicUnit = CreateObject("Scripting.Dictionary") iRow = UBound(arr, 2) iCol = UBound(arr, 1) p = Pxy(tbTitle, "单位") For i = 0 To iRow DicUnit(arr(p - 1, i)) = 1 Next With Me.CmbUnit .List = DicUnit.keys .Style = fmStyleDropDownList End With With Me.LvGrade .View = lvwReport .Gridlines = True .CheckBoxes = True .LabelEdit = lvwManual .FullRowSelect = True '添加表头 For i = 0 To UBound(tbTitle) If i = 0 Then .ColumnHeaders.Add , , tbTitle(i), arrWidth(i) Else .ColumnHeaders.Add , , tbTitle(i), arrWidth(i), lvwColumnCenter End If Next '添加记录 For i = 0 To iRow Set LvItem = .ListItems.Add LvItem.Text = arr(0, i) For j = 1 To iCol LvItem.SubItems(j) = arr(j, i) Next Next End WithEnd Sub代码解析：
（1）Line3~7，定义变量。
（2）Line8，给数组arrWidth赋值，作为ListView栏目宽度。
（3）Line9，设置用户窗体背景色。
（4）Line10~24，通过SQL语句查询数据，明细记录存入数组arr，表头字段存入数组tbTitle。
（5）Line25~35，循环arr，把“单位”装入字典，并添加到复合框的List中。
（6）Line36~58，设置LvGrade的有关属性，添加表头，添加记录。
3、在窗体Usf_Print里，CmbUnit_Change事件：
Private Sub CmbUnit_Change() Set DicGender = CreateObject("Scripting.Dictionary") Me.CmbGender.Clear Me.CmbItem.Clear Me.LvGrade.ListItems.Clear p = Pxy(tbTitle, "单位") For i = 0 To iRow If arr(p - 1, i) = Me.CmbUnit Then Set LvItem = Me.LvGrade.ListItems.Add LvItem.Text = arr(0, i) For j = 1 To iCol On Error Resume Next LvItem.SubItems(j) = arr(j, i) On Error GoTo 0 Next DicGender(arr(Pxy(tbTitle, "性别") - 1, i)) = 1 End If Next With Me.CmbGender .Clear .List = DicGender.keys End WithEnd Sub代码解析：（1）“单位”选择改变，后面的“性别”随之改变。（2）line3~5，先把右这的两个复合框清空，LvGrade清空。（3）line7~18，把符合条件的记录添加到LvGrade，其中12、14行的容错语句，解决Null值加入到ListView报错问题，16行，把“性别”加入字典。（4）line19~22，把字典DicGender的keys添加到复合框CmbGender的List中。4、在窗体Usf_Print里，CmbGender、CmbItem_Change事件：
Private Sub CmbGender_Change() On Error Resume Next Set DicItem = CreateObject("Scripting.Dictionary") Me.LvGrade.ListItems.Clear Me.CmbItem.Clear For i = 0 To iRow If arr(Pxy(tbTitle, "单位") - 1, i) = Me.CmbUnit Then If arr(Pxy(tbTitle, "性别") - 1, i) = Me.CmbGender Then Set LvItem = Me.LvGrade.ListItems.Add LvItem.Text = arr(0, i) For j = 1 To iCol LvItem.SubItems(j) = arr(j, i) Next DicItem(arr(Pxy(tbTitle, "项目") - 1, i)) = 1 End If End If Next With Me.CmbItem .List = DicItem.keys .Style = fmStyleDropDownList End WithEnd SubPrivate Sub CmbItem_Change() On Error Resume Next Me.LvGrade.ListItems.Clear For i = 0 To iRow If arr(Pxy(tbTitle, "单位") - 1, i) = Me.CmbUnit Then If arr(Pxy(tbTitle, "性别") - 1, i) = Me.CmbGender Then If arr(Pxy(tbTitle, "项目") - 1, i) = Me.CmbItem Then Set LvItem = Me.LvGrade.ListItems.Add LvItem.Text = arr(0, i) For j = 1 To iCol LvItem.SubItems(j) = arr(j, i) Next End If End If End If NextEnd Sub代码解析：性别、项目复合框Change事件，跟单位复合框相仿。5、在窗体Usf_Print里，CmdPrint打印按钮：
Private Sub CmdPrint_Click() Dim numberStr As String Dim ws As Worksheet Dim k As Integer Dim strGrp As String, strGnd As String, strItem$ Dim strGrd As String, strRnk As String On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Set ws = ThisWorkbook.Sheets("奖状模板") With Me.LvGrade For i = 1 To .ListItems.Count If .ListItems(i).Checked = True Then k = k + 1 End If Next If k = 0 Then MsgBox "未钩选任何记录！" Exit Sub Else '选择打印机，点取消退出 If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub End If End If For i = 1 To .ListItems.Count If .ListItems(i).Checked = True Then Set LvItem = .ListItems(i) strGrp = LvItem.SubItems(Pxy(tbTitle, "组别") - 1) strGnd = LvItem.SubItems(Pxy(tbTitle, "性别") - 1) strItem = LvItem.SubItems(Pxy(tbTitle, "项目") - 1) strGrd = LvItem.SubItems(Pxy(tbTitle, "成绩") - 1) strRnk = LvItem.SubItems(Pxy(tbTitle, "名次") - 1) With ws .Cells(2, 2) = LvItem.SubItems(Pxy(tbTitle, "姓名") - 1) .Cells(3, 2) = LvItem.SubItems(Pxy(tbTitle, "单位") - 1) .Cells(4, 2) = strGrp & Space(2) & strGnd & Space(2) & strItem .Cells(5, 2) = strGrd & Space(2) & strRnk ws.PrintOut copies:=1 End With End If Next End With Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox ("打印完毕！")End Sub代码解析：
（1）line2~6，定义变量。
（2）line12~16，统计勾选记录的数量k。
（3）line17~20，如果k=0则退出过程。
（4）line22~24，接单美工选择打印机。
（5）line26~42，循环ListView所有记录，如果已勾选，则把当前记录有关信息写入目标工作表“奖状模板”并打印出来。这里定义了几个字符串变量，主要目的是为了方便拼接，因为有两个单元格包含了多个字段值。
6、在窗体Usf_Print里，CmdSelectAll全选按钮：
Private Sub CmdSelectAll_Click() With Me.LvGrade If Me.CmdSelectAll.Caption = "全选" Then For i = 1 To .ListItems.Count .ListItems(i).Checked = True Next Me.CmdSelectAll.Caption = "全消" Me.CmdSelectAll.BackColor = RGB(176, 224, 230) Else For i = 1 To .ListItems.Count .ListItems(i).Checked = False Next Me.CmdSelectAll.Caption = "全选" Me.CmdSelectAll.BackColor = RGB(143, 188, 143) End If End WithEnd Sub
代码解析：点击它，LvGrade的记录在全选、全不选之间切换。
7、在窗体Usf_Print里，CmdSearch搜索按钮：
Private Sub CmdSearch_Click() On Error Resume Next Me.LvGrade.ListItems.Clear Dim searchStr As String Dim arrStr() As String iRow = UBound(arr, 2) iCol = UBound(arr, 1) arrStr = Split(Me.TextBox1, " ") For i = 0 To iRow k = 0 For j = 0 To iCol searchStr = searchStr & "|" & arr(j, i) Next For j = 0 To UBound(arrStr) If InStr(searchStr, arrStr(j)) = 0 Then k = 1 Exit For End If Next If k = 0 Then Set LvItem = Me.LvGrade.ListItems.Add LvItem.Text = arr(0, i) For j = 1 To iCol LvItem.SubItems(j) = arr(j, i) Next End If searchStr = "" NextEnd Sub代码解析：（1）line8，把TextBox1中的关键字文本，以空格分列到数组arrStr中。（2）line11~13，把一条记录的所有字段通过“|”连接起来。（3）line14~19，循环关键字数组arrStr，判断所有关键字是不是包含在当前的记录中。这里我们通过反向思维来达成目的，我们来判断关键是否不存在当前记录中，如果不存在，我们使k=1，退出循环。这样就不需要循环所有关键字。如果关键字都包含在当前记录中，那么，k应该等于0。（4）line20~26，如果k=0，说明我们找到一条符合条件的记录，我们就把它添加到ListView中去。
8、在窗体Usf_Print里，Cmd_Exit退出按钮：
Private Sub Cmd_Exit_Click() Unload MeEnd Sub
9、在窗体Usf_Print里，Pxy自定义函数，数组字段定位：
Function Pxy(arr(), FieldName As String, Optional arrType As Integer = 0) '********************************** 'arrType=0,表示一维数组 'arrType=1,表示二维数组，查找第一列 'arrType=2,表示二维数组，查找第一行 '********************************** k = 0 t = 0 Select Case arrType Case Is = 0 For i = LBound(arr) To UBound(arr) k = k + 1 If arr(i) = FieldName Then t = 1 Exit For End If Next Case Is = 1 For i = LBound(arr, 1) To UBound(arr, 1) k = k + 1 If arr(i, 1) = FieldName Then t = 1 Exit For End If Next Case Is = 2 For i = LBound(arr, 2) To UBound(arr, 2) k = k + 1 If arr(1, i) = FieldName Then t = 1 Exit For End If Next End Select If t = 1 Then Pxy = k Else Pxy = 0 End IfEnd Function代码解析：这个函数我们用了很多次了。10、在Sheet(学生成绩)里，CmdPrint打印按钮：
Private Sub CmdPrint_Click() Usf_Print.ShowEnd Sub~~~~~~End~~~~~~ 本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。