本文于2023年6月25日首发于本人同名公众号:Excel活学活用,更多文章案例请搜索关注!

☆本期内容概要☆

  • 查询条件、项目设置

  • 项目扫尾完结

大家好,我是冷水泡茶,前期我们陆续分享了【收费管理系统】的设计过程,基本能够正常使用了,今天我们再做点扫尾工作,结束此项目。

1、数据库文件选择,代码修改

原来的代码是这样的:

Private Sub TxbDataFile_DblClick(ByVal Cancel As MSForms.ReturnBoolean)    Me.TxbDataFile = FileSelectedEnd Sub

今天发现这个代码有个问题,就是在文件选择对话框,我们点“取消",那么TxbDataFile 会变成空值,因为我们点取消时,函数FileSelected的值就是空值。

那么应该怎么办呢?其实很简单,在给TxbDataFile 赋值前,先判断一下函数FileSelected的值是否为空,不为空才赋值,为空就啥也不做,保持原样。代码修改如下:

Private Sub TxbDataFile_DblClick(ByVal Cancel As MSForms.ReturnBoolean)    Dim newFile As String    newFile = FileSelected    If newFile <> "" Then        Me.TxbDataFile = newFile    End IfEnd Sub

2、明细查询模块,查询条件设置,按月份、科室、医生筛选,三者有一个递进层级关系:

(1)按月份查询,窗体启动时,默认加载最近一个月的数据,我们看一下CmbMonth_Change的代码:

Private Sub CmbMonth_Change()    On Error Resume Next    Set DicDept = CreateObject("Scritping.Dictionary")    Me.CombDepartment.Clear    Me.CombDoctor.Clear    Me.LvVoucherList.ListItems.Clear    p = Pxy(sTbtitle, "月份")    For i = 0 To iRow        If aData(p - 1, i) = Me.CmbMonth Then                        Set LvItem = Me.LvVoucherList.ListItems.Add            LvItem.Text = aData(0, i)            For j = 1 To iCol                If j = Pxy(sTbtitle, "金额") - 1 Then                    LvItem.SubItems(j) = Format(aData(j, i), "Standard")                Else                    LvItem.SubItems(j) = aData(j, i)                End If            Next            DicDept(aData(Pxy(sTbtitle, "科室") - 1, i)) = 1        End If    Next    With Me.CombDepartment        .Clear        .List = DicDept.keys    End WithEnd Sub

代码解析:

(A)先把CombDepartment、CombDoctor清空

(B)然后循环明细数组aData,把月份等于cmbmonth的记录加载到listview。我们把金额设置成千位分隔两位小数的格式,通过Pxy自定义函数确定“金额”所在列位置,如果要对其他列设置格式照葫芦画瓢即可(这里要说明一下,在前期的示例文件中,相关代码没有修改。)

(C)把“科室”装入字典DicDept并把它的keys赋值给CombDepartment的list。

(2)按科室查询,这里是按月份+科室查询:

Private Sub CombDepartment_Change()    On Error Resume Next    Set DicDoctor = CreateObject("Scripting.Dictionary")    Me.LvVoucherList.ListItems.Clear    Me.CombDoctor.Clear    For i = 0 To iRow        If aData(Pxy(sTbtitle, "月份") - 1, i) = Me.CmbMonth Then            If aData(Pxy(sTbtitle, "科室") - 1, i) = Me.CombDepartment Then                Set LvItem = Me.LvVoucherList.ListItems.Add                LvItem.Text = aData(0, i)                For j = 1 To iCol                    If j = Pxy(sTbtitle, "金额") - 1 Then                        LvItem.SubItems(j) = Format(aData(j, i), "Standard")                    Else                        LvItem.SubItems(j) = aData(j, i)                    End If                Next                DicDoctor(aData(Pxy(sTbtitle, "医生") - 1, i)) = 1            End If        End If    Next    With Me.CombDoctor        .List = DicDoctor.keys        .Style = fmStyleDropDownList    End WithEnd Sub

代码解析:代码跟CmbMonth_Change差不多,查询条件增加一个“科室”,字典改为DicDoctor。

(3)按医生查询,这里是按月份+科室+医生查询:

Private Sub CombDoctor_Change()    On Error Resume Next    Me.LvVoucherList.ListItems.Clear    For i = 0 To iRow        If aData(Pxy(sTbtitle, "月份") - 1, i) = Me.CmbMonth Then            If aData(Pxy(sTbtitle, "科室") - 1, i) = Me.CombDepartment Then                If aData(Pxy(sTbtitle, "医生") - 1, i) = Me.CombDoctor Then                    Set LvItem = Me.LvVoucherList.ListItems.Add                    LvItem.Text = aData(0, i)                    For j = 1 To iCol                        If j = Pxy(sTbtitle, "金额") - 1 Then                            LvItem.SubItems(j) = Format(aData(j, i), "Standard")                        Else                            LvItem.SubItems(j) = aData(j, i)                        End If                    Next                End If            End If        End If    NextEnd Sub

3、打印模块,跟明细查询共用同一个窗体,所以这些控件同样适用。

4、关于查询功能,可以使用的纬度很多,如果哪位朋友有明确需求的,可以在留言区提出来,如果我能做的可以添加到我们的系统里。

5、其他调整,比较零碎,不多说了,不排除日后还有一些微调。

6、系统的使用说明见第二条文章。

好,今天就到这吧。欢迎点赞、留言、分享,谢谢大家,我们下期再会。

☆往期合集☆【2023年3月】【2023年4月】【2023年5月

举报/反馈

VBA编程实战

567获赞 768粉丝
Excel应用案例、Excel VBA、公式函数使用技巧分享,思路解读...... 这里有鲜活案例、实用的技巧......
关注
0
0
收藏
分享