本文于2023年9月25日首发于本人同名其他平台，更多文章案例请搜索关注！
内容提要
更新优化后的完整代码
1、在UserForm1里，UserForm_Initialize窗体初始化：
Dim arr()Dim LvItem As ListItemDim tbTitle()Dim arrPrice()Private Sub UserForm_Initialize() Dim ws As Worksheet Dim lastRow As Integer, lastCol As Integer Dim iWidth() Set ws = ThisWorkbook.Sheets("打印数据") With ws .Activate lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = ws.Range(Cells(2, 3), Cells(lastRow, lastCol)).Value End With k = 0: m = 0 For i = 1 To UBound(arr, 2) If arr(1, i) <> "" Then ReDim Preserve tbTitle(k) tbTitle(k) = arr(1, i) k = k + 1 End If If arr(2, i) <> "" Then ReDim Preserve arrPrice(m) arrPrice(m) = arr(2, i) m = m + 1 End If Next tbTitle(0) = "下单时间" tbTitle(1) = "下单地区" tbTitle(4) = "送货地址" tbTitle(10) = "商品总价" tbTitle(11) = "备注说明" tbTitle(12) = "支付状态" iWidth = Array(60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 30) For i = 0 To UBound(tbTitle) Me.LvDetail.ColumnHeaders.Add , , tbTitle(i), iWidth(i) Next With Me.LvDetail .View = lvwReport .Gridlines = True '.Sorted = True .CheckBoxes = True .LabelEdit = lvwManual .FullRowSelect = True .ForeColor = vbBlue End With For i = 3 To UBound(arr) If arr(i, 1) <> "" Then Set LvItem = Me.LvDetail.ListItems.Add LvItem.Text = arr(i, 1) For j = 1 To Me.LvDetail.ColumnHeaders.Count - 1 LvItem.SubItems(j) = arr(i, j + 1) Next End If NextEnd Sub
代码解析：这块应该没有改动
2、在UserForm1里，CmdPrint打印按钮点击事件：
Private Sub CmdPrint_Click() 'On Error Resume Next Dim pos1 As Integer, pos2 As Integer Dim line1 As Integer, line2 As Integer Dim num As Integer, arrStr() Dim ps As PageSetup Dim ws As Worksheet, lasrRow As Integer, rng As Range, cell As Range Set ws = ThisWorkbook.Sheets("小票模板") pos1 = Pxy(tbTitle, "主机") '取得字段位置 pos2 = Pxy(tbTitle, "音箱") With Me.LvDetail '判断是否选择了记录 For i = 1 To .ListItems.Count If .ListItems(i).Checked Then k = k + 1 End If Next If k = 0 Then MsgBox "未勾选任何小票！" Exit Sub End If '选择确认打印机 If Not wContinue("即将打印所选小票！") Then Exit Sub If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub End If For i = 1 To .ListItems.Count If .ListItems(i).Checked Then With ws '初始化打印模板 .Activate Set cell = ws.Columns("B").Find(What:="商品名称", LookIn:=xlValues, LookAt:=xlPart) line1 = cell.Row Set cell = ws.Columns("B").Find(What:="商品总价", LookIn:=xlValues, LookAt:=xlPart) line2 = cell.Row If line2 - line1 > 2 Then ws.Rows(line1 + 2 & ":" & line2 - 1).Delete End If line2 = line1 + 2 .Rows(line1 + 1).ClearContents End With num = 0 For j = pos1 To pos2 '计算有数量的商品个数 If Len(.ListItems(i).SubItems(j - 1)) > 0 Then num = num + 1 End If Next lastRow = ws.UsedRange.Rows.Count Set rng = ws.Range("B2:E" & lastRow) For Each cell In rng '循环区域，定位字段并取值 If InStr(cell.Value, "电话") Then cell.Offset(0, 1).NumberFormatLocal = "@" End If If InStr(cell.Value, "社区") Then cell.Offset(0, -1).Value = .ListItems(i).SubItems(Pxy(tbTitle, "下单地区") - 1) ElseIf InStr(cell.Value, "下单时间") Then cell.Offset(0, 1).Value = .ListItems(i).Text ElseIf InStr(cell.Value, "商品总价") Then cell.Offset(0, 3).Value = .ListItems(i).SubItems(Pxy(tbTitle, "商品总价") - 1) ElseIf cell <> "" Then itemname = Replace(cell.Value, "：", "") ipos = Pxy(tbTitle, itemname) If ipos > 0 Then cell.Offset(0, 1).Value = .ListItems(i).SubItems(ipos - 1) End If End If Next memo = .ListItems(i).SubItems(Pxy(tbTitle, "备注说明") - 1) '备注字段的值，后面判断用 If num > 0 Then '商品个数大于0,正常写入ListView相关字段的值 If num > 1 Then '商品个数大于1,模板插入行 ws.Rows(line2 & ":" & line2 + num - 2).Insert Shift:=xlDown End If k = 0 For j = pos1 To pos2 If Len(.ListItems(i).SubItems(j - 1)) > 0 Then ws.Cells(line1 + 1 + k, 2) = tbTitle(j - 1) ws.Cells(line1 + 1 + k, 3) = arrPrice(j - pos1) Set cell = ws.Cells(line1 + 1 + k, 4) cell.Value = .ListItems(i).SubItems(j - 1) cell.Offset(0, 1) = cell.Value * cell.Offset(0, -1).Value k = k + 1 End If Next ElseIf Len(memo) > 0 Then '商品个数等于0,且备注字段有内容的，提取商品名称 For j = pos1 To pos2 If InStr(memo, tbTitle(j - 1)) Then ReDim Preserve arrStr(num) arrStr(num) = tbTitle(j - 1) num = num + 1 End If Next If num > 1 Then '如果商品个数大于1的，插入行 ws.Rows(line2 & ":" & line2 + num - 2).Insert Shift:=xlDown End If For j = LBound(arrStr) To UBound(arrStr) ws.Cells(line1 + 1 + j, 2) = arrStr(j) ws.Cells(line1 + 1 + j, 3) = arrPrice(Pxy(tbTitle, arrStr(j)) - pos1) Next End If '"确认签收"是最后行于，定位其行号，定义打印区域并打印 Set cell = ws.Columns("B").Find(What:="确认签收", LookIn:=xlValues, LookAt:=xlPart) lastRow = cell.Row Set ps = ws.PageSetup ps.PrintArea = ws.Range("B2:E" & lastRow).Address ws.PrintOut Copies:=1 '等待0.5秒，主要为了防止打印任务过多造成问题，可以根据实际情况调整。 Application.Wait Now + TimeSerial(0, 0, 0.5) End If Next End With MsgBox "打印完毕！" Unload MeEnd Sub
代码解析：这块改动较大，在第一条文章中，重点部分都说得差不多了，代码中也写有少量的注释。
3、在UserForm1里，全选、退出按钮及两个自定义函数：
Private Sub CmdSelectAll_Click() With Me.LvDetail 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 SubPrivate Sub CmdExit_Click() Unload MeEnd SubFunction Pxy(arr() As Variant, searchValue As Variant) As Long t = LBound(arr) t = 1 - t For i = LBound(arr) To UBound(arr) If arr(i) = searchValue Then Pxy = i + t Exit Function End If Next Pxy = -1 ' 如果未找到值，则返回 -1End FunctionFunction wContinue(Msg) As Boolean '确认继续函数 Dim Config As Long Config = vbYesNo + vbDefaultButton2 + vbQuestion Ans = MsgBox(Msg & Chr(10) & "是(Y)继续?" & Chr(10) _ & "否(N)返回！", Config, "请确认操作！") wContinue = Ans = vbYesEnd Function
代码解析：这块也没有改动。
4、在工作表“打印数据”里，打印命令按钮：
Private Sub CmdPrint_Click() UserForm1.ShowEnd Sub
代码解析：启动用户窗体。
5、在工作表“小票模板”里，打印命令按钮：
Private Sub CmdPrint_Click() Application.ScreenUpdating = False UserForm1.Show Application.ScreenUpdating = TrueEnd Sub
代码解析：启动用户窗体。过程当中，停止屏幕刷新。
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！