实验摘要

获奖文凭打印好意思满代码

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~~~~~~ 本站仅提供存储就业，扫数实验均由用户发布，如发现存害或侵权实验，请点击举报。

• 皮具
• 面的
• 改动
• 性别
• 随之