本文于2023年5月23日首发于本人同名公众号，更多文章案例请搜索关注！
☆本期内容概要☆
用户窗体设置：收费结算模块设置（2）
Excel VBA 操作ACCESS数据库表，SQL查询语句。
Combox控件显示多列List
简单的日期选择窗体
大家好，我是冷水泡茶，上期我们分享了【收费管理系统】收费结算模块的设计【Excel VBA 收费结算模块/一步一步带你设计【收费管理系统】06】，没有讲完，本期我们继续。
下面我们就开始：
1、修改Access数据库，“tb部门”表结构，增加一个“部门类型”，分为“后勤”，“业务”，后期视情况再增加类型。
在收费结算选择医生时，过滤掉其他人员。修改用户窗体医生下拉列表选项：应该是从“tb人员”表中取数。
这里修改窗体启动时的代码：
'客户、渠道、医生、科目从数据库取出记录，作为复合框的ListarrCustomer = GetData(dataFile, "Select distinct 客户 from tb收费明细")Me.CmbCustomer.List = FlattenArray(arrCustomer)arrSource = GetData(dataFile, "Select distinct 渠道 from tb收费明细")Me.CmbSource.List = FlattenArray(arrSource)Me.CmbSource.Text = "无"arrDoctor = GetData(dataFile, "Select distinct 姓名,部门名称 from tb人员 " _ & "where 部门名称 in (select 部门名称 from tb部门 where 部门类型='业务') ")With Me.CmbDoctor .ColumnCount = 2 .ColumnWidths = "40, 60" .List = Application.WorksheetFunction.Transpose(arrDoctor) .TextColumn = 1 .Width = 100End WitharrDepartment = GetData(dataFile, "Select distinct 部门名称 from tb部门 where 部门类型='业务'")Me.CmbDepartment.List = Application.WorksheetFunction.Transpose(arrDepartment)
代码解析：
（1）修改了复合框List赋值的问题，从数据库中查询出来的数据是横向排列的，这里需要转置数组，如果只有一个字段，也可以用我们前面分享过的自定义函数FlattenArray来把二维数组变成一维数组，这里两种方法我都用了。
（2）修改了医生、科室的取值数据源，原来是从“tb收费明细”中取的，应该从“tb人员”表中取数。这里有个筛选，仅选取部门类型为“业务”的人员，我们可以单独来看一下SQL语句：
SQL = "Select distinct 姓名,部门名称 from tb人员 " _ & "where 部门名称 in (select 部门名称 from " _ & "tb部门 where 部门类型='业务')
这句SQL的含义是：选取姓名、部门名称，条件是部门类型为“业务”，这是一个跨表查询语句。
这里的复合框List显示两列，实现方法看上面代码吧。
2、修改Me.CmbDoctor的Change事件代码：
Private Sub CmbDoctor_Change() SQL = "select 部门名称 from tb人员 where 姓名='" & Me.CmbDoctor & "'" Me.CmbDepartment = RecordValue(dataFile, SQL)End Sub
代码解析：医生变了，他所在的部门/科室也跟着一起变。当然，如果两个医生属于同一个科室的，那么CmbDepartment的值是不变的。实际上应该这样表述，我们看到是没有变化，但它是被重新赋值了的，只不过新的值等于旧的值。
3、修改日期TxbDate的Change事件，单号跟随改变：
Private Sub TxbDate_Change() SQL = "select count(*) from tb收费明细 where 日期=#" & CDate(Me.TxbDate) & "# " If RecordValue(dataFile, SQL) > 0 Then SQL = "select top 1 单号 from tb收费明细 where 日期=#" & CDate(Me.TxbDate) & "# order by 单号 DESC " preNumber = RecordValue(dataFile, SQL) Me.TxbNumber = Left(preNumber, 9) & Format(Val(Right(preNumber, 3)) + 1, "000") Else Me.TxbNumber = "D" & Format(Me.TxbDate, "YYYYMMDD") & "001" End IfEnd Sub
代码解析：
（1）首先，我们查询一下“tb收费明细”表中，包含当前日期的记录。
（2）如果存在记录，我们取出最大的单号，再加1，赋值给TxbNumber
（3）如果不存在记录，则按编码规则生成第1号，赋值给TxbNumber
4、修改了日期、单号左右的箭头按钮代码：
日期："<<",">>" Me.TxbDate = CDate(Me.TxbDate) - 1 Me.TxbDate = CDate(Me.TxbDate) + 1 单号："<<",">>"Private Sub CmdNumberDown_Click() If Right(Me.TxbNumber, 3) <> "001" Then Me.TxbNumber = Left(Me.TxbNumber, 9) _ & Format(Right(Me.TxbNumber, 3) - 1, "000") End IfEnd SubPrivate Sub CmdNumberUp_Click() If Right(Me.TxbNumber, 3) <> "999" Then Me.TxbNumber = Left(Me.TxbNumber, 9) _ & Format(Right(Me.TxbNumber, 3) + 1, "000") End IfEnd Sub
代码解析：
（1）日期：简单处理，直接加、减1。
（2）单号：判断单号是否是最低限“......001”，最高限“......999”，如果是，则没有动作，维持原状，否则在后三位数字上加、减1。
5、修改用户窗体Usf_ChangeDate代码，此窗体供双击收费结算界面的日期时调用（实际双击的是日期上一层的标签），这里的日期是不能手工直接修改的，目的前面我们也讲过，防止输入数据格式不对造成错误。
Private Sub UserForm_Activate() Dim currDate As Date Dim iDate As Date Dim LastDay As Integer SQL = "select 日期 from tb收费明细 where ID in (select Max(ID) from tb收费明细)" currDate = RecordValue(dataFile, SQL) Me.CombYear = Year(currDate) For i = 1 To 3 Me.CombYear.AddItem Year(currDate) - 2 + i Next If IsFormActive("Usf_AddAndModify") Then If Usf_AddAndModify.TxbDate = "" Then Exit Sub iDate = CDate(Usf_AddAndModify.TxbDate) LastDay = Day(DateSerial(Year(iDate), Month(iDate) + 1, 1) - 1) Me.CombMonth = Month(iDate) For i = 1 To 12 Me.CombMonth.AddItem i Next Me.CombDay.Clear For i = 1 To LastDay Me.CombDay.AddItem i Next Me.CombDay.Text = Day(iDate) End If Me.CombDay.SetFocusEnd SubPrivate Sub combyear_Change() Me.CombMonth.Text = Month(Date) iDate = CDate(Me.CombYear & "-" & Me.CombMonth & "-" & "1") LastDay = Day(DateSerial(Year(iDate), Month(iDate) + 1, 1) - 1) Me.CombDay.Clear For i = 1 To LastDay Me.CombDay.AddItem i Next Me.CombDay.Text = Day(Date)End SubPrivate Sub CombMonth_Change() iDate = CDate(Me.CombYear & "-" & Me.CombMonth & "-" & "1") LastDay = Day(DateSerial(Year(iDate), Month(iDate) + 1, 1) - 1) Me.CombDay.Clear For i = 1 To LastDay Me.CombDay.AddItem i Next Me.CombDay.Text = Day(Date)End SubPrivate Sub CmdToday_Click() Me.CombMonth = Month(Date) Me.CombDay = Day(Date)End SubPrivate Sub CmdConfirm_Click() ConfirmDate = CDate(Me.CombYear & "-" & Me.CombMonth & "-" & Me.CombDay) If IsFormActive("Usf_AddAndModify") Then With Usf_AddAndModify .TxbDate = ConfirmDate End With End If Unload MeEnd SubPrivate Sub CmdCancel_Click() Unload MeEnd Sub
代码解析：
（1）Usf_ChangeDate启动时，取得“tb收费明细”表中最后一条记录的日期，这里我们看一下SQL语句：
SQL = "select 日期 from tb收费明细 " _ & "where ID in (select Max(ID) from tb收费明细)"
取得ID最大的记录的日期。有可能不是最大的日期，补录以前日期的单据时就会出现这种情况。
（2）根据Usf_AddAndModify的TxbDate的日期值，初始化本用户窗体上的CombYear、CombMonth、CombDay的值。
（A）年，值为当前日期的年，List为当前年度前后各加1年。
（B）月，值为当前日期的月，List为1~12，直接循环赋值。
（C）日，根据“月”的值，确定是1~28还是1~31等，这里看一下取得给定年度所在月份的最后一天的方法：
LastDay = Day(DateSerial(Year(iDate), Month(iDate) + 1, 1) - 1)
这里使用DateSerial函数取得下月1日的日期序列值，减去1，就是本月最后一天的日期序列值，再用Day函数，取得“日”的值。
（D）CombYear的Change事件，重新取得该年所在月份的最后一天，主要影响是2月，可以进行更精确的判断，如果月份为2，甚至再进一步判断是否是闰年，来确定月份最后一天，如果不是2月，月度最后一天可以不变。这里简单处理，重新计算一下了事。
（E）CombMonth的Change事件，根据月份，计算当月最后一天，赋值给CombDay的List。
（F）“今天”按钮点击事件，直接把年月日改成今天，不用去筛选了。
（G）“确定”按钮点击事件，先把年、月、日组合成日期格式，再赋值给Usf_AddAndModify窗体上的TxbDate。
（H）“退出”按钮，没啥好说的，直接Unload。
由于时间与篇幅的关系，本期就先写到这，“收费结算”模块还没讲完，估计还得花个1~2期。
今天的内容就这么多，后面会继续，敬请关注！还请大家多多点赞、留言、分享，谢谢大家，我们下期再会！
☆猜你喜欢☆
本文使用 文章同步助手 同步，本文于2023年5月23日首发于本人同名公众号，更多文章案例请搜索关注！