本文于2023年5月21日首发于本人同名公众号，更多文章案例请搜索关注！
☆本期内容概要☆
用户窗体设置：收费结算模块设置（上）
Excel VBA 操作ACCESS数据库表，更新、删除、添加记录。
数组赋值给Combox控件的List
用透明标签覆盖文本框限制修改
上期我们分享了【收费管理系统】部门、人员等项目的设计【Excel VBA 部门、人员、收费项目分类设置/一步一步带你设计【收费管理系统】05】，本期我们将设计【收费结算】模块功能！由于该模块功能相对复杂，今天只能完成一部分。
下面我们就开始：
1、首先在Access数据库中创建新表，重命名为“tb收费明细”。
该表用于存放收费明细数据，所以是非常重要的一张表。这里我先手工增加一条记录。（注：字段后面有修改，图就不更新了。）
2、打开VBA编辑器，在用户窗体Usf_Main上增加命令按钮CmdCollection，Caption收费结算。
3、双击“收费设置”按钮，进入代码区，复制CmdUsers命令按钮的代码，把“tb用户”改为“tb收费明细”：
（注：代码后面有修改、图也不更新了。）
4、修改窗体“Usf_AddAndModify”启动代码，
（1）初始设置部分：
ElseIf currTable = "tb收费明细" Then initSQL = "select top 1 * from " & currTable arrWidth = Array(40, 0, 0, 0, 0, 0, 0, 200, 120, 80, 0, 200, 60, 60, 60, 60) Me.LbTitle = "收费结算单" EditableField = "All" strRequiredField = "All"Else
代码简析：
（A）SQL语句，这里只选1条记录，因为收费明细项目我们主要是增加新记录，不需要查询所有已存在的记录，这里选1条记录，是为了取得tb收费明细表的字段名称。
（B）arrWidth，字段宽度，有些设为0，在ListView中我们就看不到（实际上是可以看到的，拖动ListView表头即可显示，为了使得Listview的表头不能随便拖动，我采用了一个替代方法：
（2）针对“tb收费明细”设置数组aData（）：
If currTable = "tb收费明细" Then ReDim aData(0 To UBound(tbTitle, 1) - 1, 0 To 5) '把金额预填0 For i = 0 To UBound(aData, 2) aData(Pxy(tbTitle, "金额") - 1, i) = Format(0, "Standard") Next Else If RecordValue(dataFile, "select count(*) from " & currTable) > 0 Then aData = GetData(dataFile, initSQL) End If End If
代码简析：如果是tb收费明细，我们把数组直接定义为6条空记录，把金额预填0。因为收费结算时，我们需要的是录入新记录，不需要修改旧记录。
（3）针对“tb收费明细”设置部分控件的属性，这里我们增加了一个Frame1（其实它一直都在，只是在操作其他表的时候，它是隐藏的，在操作tb收费明细时，需要它显示出来。），上面加了一些标签控件、文本框控件、复合框控件等，具体就不列了，参见前图。
（4）针对“tb收费明细”，增加了一些代码：
'取得最近日期，按日期降序排列，取最大，如果没有记录，则为当前日期SQL = "Select top 1 日期 from tb收费明细 order by 日期 DESC"If RecordValue(dataFile, "select count(*) from tb收费明细") > 0 Then iDate = RecordValue(dataFile, SQL)Else iDate = Format(Date, "YYYY/MM/DD")End If.TxbDate = iDate'取最大单号，加上1,为当前单号。如果没有记录，当前单号为1'单号规则：字母D+日期（YYYYMMDD）+3位顺序号，即一天最多999号。If VoucherProcType = "结算制单" Then Dim preNumber As String SQL = "Select top 1 单号 from tb收费明细 order by 单号 DESC" If RecordValue(dataFile, "select count(*) from tb收费明细") > 0 Then preNumber = RecordValue(dataFile, SQL) If Mid(preNumber, 2, 8) = CStr(Format(iDate, "YYYYMMDD")) Then .TxbNumber = Left(preNumber, 9) & Format(Right(preNumber, 3) + 1, "000") Else .TxbNumber = "D" & Format(iDate, "YYYYMMDD") & "001" End If '客户、渠道、医生、科目从数据库取出记录，作为复合框的List arrCustomer = GetData(dataFile, "Select distinct 客户 from tb收费明细") Me.CmbCustomer.List = arrCustomer arrSource = GetData(dataFile, "Select distinct 渠道 from tb收费明细") Me.CmbSource.List = arrSource Me.CmbSource.Text = "无" arrDoctor = GetData(dataFile, "Select distinct 医生 from tb收费明细") Me.CmbDoctor.List = arrDoctor arrDepartment = GetData(dataFile, "Select distinct 科室 from tb收费明细") Me.CmbDepartment.List = arrDepartment Else .TxbNumber = "D" & Format(iDate, "YYYYMMDD") & "001" Me.CmbSource = "无" End If Me.CmdVoucherProcess.Caption = "单据修改"Else Me.CmdVoucherProcess.Caption = "结算制单"End If'日期遮盖层，防止手工修改日期，造成日期格式不对，数据错误'通过LbTopDate标签的双击事件，调用输入日期的窗体Usf_ChangeDateWith .LbTopDate .Visible = True .Top = Me.TxbDate.Top - 1 .Left = Me.TxbDate.Left - 1 .Width = Me.TxbDate.Width + 2 .Height = Me.TxbDate.Height + 2 .Caption = "" .BackStyle = fmBackStyleTransparent .ZOrder 0End WithIf VoucherProcType = "单据修改" Then Me.CmdVoucherCopy.Caption = "修改" Me.CmdVoucherCopy.ForeColor = vbRed Me.TxbDate = "" Me.TxbNumber = "" Me.BackColor = RGB(204, 204, 255) '.Frame1.BackColor = Usf_AddAndModify.BackColorEnd If
代码解析：
（1）取得数据库中tb收费明细表的最大日期，赋值给TxbDate
（2）取得最大单号，加上1，赋值给TxbNumber。这里代码还有个单号中的日期与当前日期的比较，其实没必要，它们必然是相等的，时间关系暂时先这么着吧。后面再改。
（3）单号的规则是，字母D加上8位日期（YYYYMMDD），这里用Format函数转换格式，再加上3位顺序号。比如：D20230520001。
（4）客户、渠道、医生、科目从数据库取出记录，作为复合框的List，这里运用我们的自定义函数GetData(dataFile,SQL)。这些复合框如果没有可选择的，则可直接手工输入，相当于新增了。
（5）防止手工修改日期，在其上增加一层透明的标签。只有双击其上的标签、或者点左右的箭头才能修改。单号也类似，一般情况下单号不需要修改。
（6）这里有个public 变量VoucherProcType，凭证处理类型，作为区分是要新增记录（结算制单）还是要修改记录（单据修改）。看上去有点别扭，原因我在前期也说过，这个收费系统是参照我已经完成的一个小项目《财务管理系统》来的，用户窗体都是直接复制来的，代码也有很多复制成分。这里的“收费明细”对应那边的“凭证”。有些变量还是保持原样吧，省得改乱了。
（7）由于时间关系，还有一些需要完善的地方，比如“收费项目”的选择，日期的Change事件（影响单号），医生的Change事件（影响部门\科室)等，我们后期再做。
今天的内容就这么多，后面会继续，敬请关注！还请大家多多点赞、留言、分享，谢谢大家，我们下期再会！
☆猜你喜欢☆
本文使用 文章同步助手 同步，本文于2023年5月21日首发于本人同名公众号，更多文章案例请搜索关注！