Excel VBA 收费结算模块一步一步带你设计【收费管理系统】06

本文于2023年5月21日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

☆本期内容概要☆

• 用户窗体设置：收费结算模块设置（上）
• 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_ChangeDate
With .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 0
End With
If VoucherProcType = "单据修改" Then
    Me.CmdVoucherCopy.Caption = "修改"
    Me.CmdVoucherCopy.ForeColor = vbRed
    Me.TxbDate = ""
    Me.TxbNumber = ""
    Me.BackColor = RGB(204, 204, 255)
    '.Frame1.BackColor = Usf_AddAndModify.BackColor
End 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日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！