实质纲要
获奖文凭打印无缺代码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~~~~~~ 本站仅提供存储就业,悉数实质均由用户发布,如发现存害或侵权实质,请点击举报。