本文于2023年6月23日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
☆本期内容概要☆
收费单据补打、批量打印
大家好，我是冷水泡茶，前期我们分享了【收费管理系统】的设计过程，已经接近尾声了，今天我们再增加一个功能：收费单据补打。
如果我们在收费结算界面没有打印收费单，或者在结算完毕之后需要再打印的，我们就需要这个功能模块。我们来看一下效果：
我们继续来看制作过程与思路：
在主界面添加命令按钮“单据打印”：
Private Sub CmdPrint_Click() tempValue = "收费单打印" Usf_VoucherList.Show Unload MeEnd Sub
我们点击单据打印，启动“Usf_VoucherList”窗体，与我们“明细查询”是同一个窗体。
我们勾选需要打印的收费单，点打印，即可打印所选择的收费单据。
我们看一下主要代码：
1、命令按钮“打印”：
Private Sub CmdPrint_Click() Dim numberStr As String Dim arrNumber() On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False ActiveSheet.Visible = xlSheetVisible With Me.LvVoucherList For i = 1 To .ListItems.Count currNumber = .ListItems(i).SubItems(Pxy(sTbtitle, "单号") - 1) If .ListItems(i).Checked = True Then '记录符合条件的单号 ReDim Preserve arrNumber(N1) arrNumber(N1) = currNumber N1 = N1 + 1 End If Next End With If N1 = 0 Then MsgBox "未钩选任何单据！" Exit Sub End If '选择打印机，点取消退出 If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub End If For i = LBound(arrNumber) To UBound(arrNumber) Call PrintSingleVoucher(CStr(arrNumber(i))) Next Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox ("打印完毕！") Unload Me Sheets("Main").ActivateEnd Sub
代码解析：
（1）循环ListView，记下勾选的单号存到数组arrNumber
（2）如果选择的单号数量为0，则退出过程
（3）弹出打印机选择对话框，如果选取消则退出过程
（4）循环数组arrNumber，调用PrintSingleVoucher过程，该过程有一个参数为单号， 这里就是数组的每一个元素。
2、打印过程PrintSingleVoucher的代码（在MyModule2里）：
Sub PrintSingleVoucher(BillingNumber As String) ' Dim arrT(), tbTitle() Dim amount As Double SQL = "select * from tb收费明细 where 单号='" & BillingNumber & "'" arrT = GetData(dataFile, SQL) tbTitle = GetFields(dataFile, SQL) Sheets("Print01").Activate Range("B5:G11").ClearContents For p = 0 To UBound(arrT, 2) amount = amount + arrT(Pxy(tbTitle, "金额") - 1, p) Range("B" & p + 5) = arrT(Pxy(tbTitle, "收费项目") - 1, p) '收费项目 Range("F" & p + 5) = arrT(Pxy(tbTitle, "金额") - 1, p) '金额 If arrT(Pxy(tbTitle, "备注") - 1, p) <> "" Then Range("G5") = Range("G5") & arrT(Pxy(tbTitle, "备注") - 1, p) & Chr(10) '备注 End If Next Range("B3") = "交款人：" & arrT(Pxy(tbTitle, "客户") - 1, 0) Range("F12") = "收款人：" & arrT(Pxy(tbTitle, "收款人") - 1, 0) Range("F11") = amount Range("B11") = "合计（大写）：" & JEZH(Range("F11").Value) Range("G2") = arrT(Pxy(tbTitle, "日期") - 1, 0) Range("G3") = "№:" & arrT(Pxy(tbTitle, "单号") - 1, 0) Sheets("Print02").Activate Range("B4:G11").ClearContents Range("B2") = "交款人：" & arrT(Pxy(tbTitle, "客户") - 1, 0) Range("E2") = arrT(Pxy(tbTitle, "日期") - 1, 0) Range("G2") = "№:" & arrT(Pxy(tbTitle, "单号") - 1, 0) Range("B16:G23").ClearContents Range("B14") = "交款人：" & arrT(Pxy(tbTitle, "客户") - 1, 0) Range("E14") = arrT(Pxy(tbTitle, "日期") - 1, 0) Range("G14") = "№:" & arrT(Pxy(tbTitle, "单号") - 1, 0) For p = 0 To UBound(arrT, 2) Range("B" & p + 4) = arrT(Pxy(tbTitle, "科室") - 1, p) '科室 Range("B" & p + 4) = arrT(Pxy(tbTitle, "科室") - 1, p) '科室 Range("C" & p + 4) = arrT(Pxy(tbTitle, "医生") - 1, p) '医生 Range("D" & p + 4) = arrT(Pxy(tbTitle, "收费项目") - 1, p) '收费项目 Range("E" & p + 4) = arrT(Pxy(tbTitle, "收款方式") - 1, p) '收款方式 Range("F" & p + 4) = arrT(Pxy(tbTitle, "金额") - 1, p) '金额 If arrT(Pxy(tbTitle, "备注") - 1, p) <> "" Then Range("G4") = Range("G4") & arrT(p, 11) & Chr(10) '备注 End If Range("B" & p + 16) = arrT(Pxy(tbTitle, "科室") - 1, p) '科室 Range("B" & p + 16) = arrT(Pxy(tbTitle, "科室") - 1, p) '科室 Range("C" & p + 16) = arrT(Pxy(tbTitle, "医生") - 1, p) '医生 Range("D" & p + 16) = arrT(Pxy(tbTitle, "收费项目") - 1, p) '收费项目 'Range("E" & p + 16) = arrT(Pxy(tbTitle, "收款方式") - 1, p) '收款方式 Range("F" & p + 16) = arrT(Pxy(tbTitle, "金额") - 1, p) '金额 If arrT(Pxy(tbTitle, "备注") - 1, p) <> "" Then Range("G16") = Range("G16") & arrT(p, 11) & Chr(10) '备注 End If Next Range("F10") = amount Range("B10") = "合计（大写）：" & JEZH(amount) Range("B11") = "负责人：" & "" Range("D11") = "主治医师：" & "" If arrT(Pxy(tbTitle, "渠道") - 1, 0) <> "无" Then Range("E11") = "收款人：" & arrT(Pxy(tbTitle, "收款人") - 1, 0) Range("G11") = "介绍人：" & arrT(Pxy(tbTitle, "渠道") - 1, 0) Else Range("F11") = "收款人：" & arrT(Pxy(tbTitle, "收款人") - 1, 0) End If Range("F22") = amount Range("B22") = "合计（大写）：" & JEZH(amount) Range("B23") = "负责人：" & "" Range("D23") = "主治医师：" & "" If arrT(Pxy(tbTitle, "渠道") - 1, 0) <> "无" Then Range("E23") = "收款人：" & arrT(Pxy(tbTitle, "收款人") - 1, 0) Range("G23") = "介绍人：" & arrT(Pxy(tbTitle, "渠道") - 1, 0) Else Range("F23") = "收款人：" & arrT(Pxy(tbTitle, "收款人") - 1, 0) End If For p = 1 To 2 Sheets("Print0" & p).Activate ActiveSheet.Cells(1, 1).Select ActiveSheet.Visible = xlSheetVisible ActiveSheet.PrintOut Copies:=1 '执行打印 Sheets("Print0" & p).Visible = 0 Next Sheets("Main").ActivateEnd Sub
代码解析：
（1）根据参数BillingNumber 查询数据库该单号的记录
（2）把记录的相关字段填到Print01,Print02这两张表里并打印出来。
（3）代码看着很长，实际上并不复杂，就是比较繁琐。
（4）在“收费结算”界面，保存后立即打印的功能，也改为调用这个打印过程。
另外，进行了若干代码的调整：
1、“明细查询"：改为查询所有明细数据
2、登录界面增加了“数据库文件“路径，双击文本框可以重新选择数据库文件，意味着我们的EXCEL文件与Access数据库文件可以不在一个目录下。
3、把数据库文件路径存到“Settings”表中，作为DataFile的数据源，把所有模块的DataFile取值进行调整。统一到“Settings"表中取。
4、其他一些细节调整，就不多说了。
到这，这个【收费管理系统】基本能用起来了，还有一些细节方面需要再完善，我们下期再说。
好，今天就到这吧。欢迎点赞、留言、分享，谢谢大家，我们下期再会。
☆往期合集☆【2023年3月】【2023年4月】【2023年5月】