formb0.frm

用VB编写的家庭理财程序

Private Sub Form_Load()
    
Db_fN2 = App.Path & StrDir & Db_Name2
StrCrq = Format(Date, "yyyy.mm.dd")

    If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub        ' 连接库 T                                               ' 打开数据库 2
    
       StrT1 = "T_tm"                                            ' 条目表 MyRs1
       StrT2 = "T_zm"                                            ' 账目表 MyRs2
       StrT3 = "T_yf"                                            ' 报销表 MyRs3
        
    Rq = StrCrq
    
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
    
End Sub

Private Sub Form_Activate()
    
    If blnTc = True Then Unload Me: Exit Sub
       
    Call P_grd1                                                  ' T_yf 表
    Call P_yftj                                                  ' 搜索条件
    Call P_cmb1                                                  ' 姓名
    Call P_grd2                                                  ' T_zm 表
    Call P_init
        
    intRo1 = 1
    intRo2 = 1
    intRo3 = 1
    
End Sub

Private Sub P_yftj()                                             ' 医药费搜索条件
    StrSQL = "Select * From " & StrT1 & _
             " Where Dm Like 'Lb%' And (Jc Like 's' Or Jc Like 'z')" & _
             " Order By Xh"
    Set MyRs0 = New Recordset
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N5 = MyRs0.RecordCount:
    If N5 > 0 Then
       ReDim arrSl(N5, 2)
       strYf = ""
       For i = 1 To N5
           If MyRs0![Mc] Like "*医药*" Then
              
              If MyRs0![Jc] = "z" Then
                 strYd = " Where Sz='z' And Lb='" & MyRs0![Bz] & "' And Bh=0"
              End If
              
              If strYf = "" Then
                 strYf = strYf & "Sz='" & MyRs0![Jc] & "' And Lb='" & MyRs0![Bz] & "'"
              Else
                 strYf = strYf & " Or Sz='" & MyRs0![Jc] & "' And Lb='" & MyRs0![Bz] & "'"
              End If
           End If
           MyRs0.MoveNext
       Next
       strYf = " Where (" & strYf & ")": strTj = strYf
       MyRs0.Close
    Else
       MsgBox "  没有发现医药费类别信息 ...  ", 48, "  请注意"
       strTj = ""
    End If
End Sub

Private Sub P_cmb1()                                             ' 姓名 Combo1
    strDm = "Xm"
    StrSQL = "Select * From " & StrT1 & " Where Dm Like '" & strDm & "%' Order By Xh"
    Set MyRs0 = New Recordset
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N0 = MyRs0.RecordCount
       If N0 > 0 Then
          N0 = MyRs0.RecordCount: ReDim arrXm(N0, 2)
          With Combo1
              .Clear
              .AddItem " "
               For i = 1 To N0
                  .AddItem " " & MyRs0![Mc]
                   arrXm(i, 1) = MyRs0![dm]
                   arrXm(i, 2) = MyRs0![Mc]
                   MyRs0.MoveNext
               Next
          End With
          MyRs0.Close
       End If
End Sub

Private Sub P_init()
    strFs = "0"
    For i = 0 To 3
        Text1(i) = "": Text1(i).Enabled = False
    Next
    Label3 = "备注："
    Combo1.Text = ""
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command7.Enabled = False
End Sub

Private Sub P_grd1()
    Set MyRs3 = New Recordset                                    ' T_yf 表
    StrSQL = "SELECT * FROM " & StrT3 & " Order By Bh Desc"
    MyRs3.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N3 = MyRs3.RecordCount                                    ' N3: 条数
       ReDim arrBh(N3 + 10, 3)
         If N3 = 0 Then
            Bh = 0                          ' T_yf( Bh,Xm,Sj,Je,Sl,Bx,Rq,Bz)
         Else
            Bh = MyRs3![Bh]                                      ' 最后的编号
         End If
    With MSFlexGrid1
        .Clear
        .Rows = IIf(N3 + 2 < intRs1, intRs1, N3 + 2) + 1
        .Cols = 8
        .Height = 225 * (intRs1 + 1) + 90
        .Row = 0: .Col = 0: .Text = "编号":            .ColWidth(0) = 500
                  .Col = 1: .Text = "  姓 名 ":        .ColWidth(1) = 1050
                  .Col = 2: .Text = "    起 止 时 间": .ColWidth(2) = 2250
                  .Col = 3: .Text = "  金  额 ":       .ColWidth(3) = 980
                  .Col = 4: .Text = " 单据 ":          .ColWidth(4) = 640
                  .Col = 5: .Text = " 报销 ":          .ColWidth(5) = 640
                  .Col = 6: .Text = "  报销日期 ":     .ColWidth(6) = 1160
                  .Col = 7: .Text = "  备 注":         .ColWidth(7) = 1160 - IIf(.Rows > intRs1 + 1, 270, 0)
                   If N3 > 0 Then
                      MyRs3.MoveFirst
                          Jep = 0: Dsp = 0
                      For i = 1 To N3
                          arrBh(i, 0) = MyRs3![Bh]
                          arrBh(i, 1) = MyRs3![Bx]
                          arrBh(i, 2) = MyRs3![Rq]
                          Rq = MyRs3![Rq]
                         .TextMatrix(i, 0) = MyRs3![Bh] & " "
                         .TextMatrix(i, 1) = " " & MyRs3![Xm]
                         .TextMatrix(i, 2) = " " & MyRs3![Sj]
                         .TextMatrix(i, 3) = Format(MyRs3![Je], "0.00 ")
                         .TextMatrix(i, 4) = MyRs3![Sl] & " "
                         .TextMatrix(i, 5) = IIf(MyRs3![Bx] = "B", "  √", "")
                         .TextMatrix(i, 6) = " " & MyRs3![Rq]
                         .TextMatrix(i, 7) = " " & MyRs3![Bz]
                          Jep = Jep + MyRs3![Je]
                          Dsp = Dsp + MyRs3![Sl]
                          MyRs3.MoveNext
                      Next
                         .TextMatrix(i + 1, 1) = " 累计"
                         .TextMatrix(i + 1, 3) = Format(Jep, "0.00 ")
                         .TextMatrix(i + 1, 4) = Dsp & " "
                   End If
'        .MergeCol(1) = True
'        .MergeCells = flexMergeRestrictColumns                   ' 单元格合并
        .Visible = True
    End With
End Sub

Private Sub P_grd2()                                             ' 显示 T_zm 表
    Set MyRs2 = New Recordset
    StrSQL = "SELECT * FROM " & StrT2 & strTj & " Order By Bh Desc,Rq Desc,Xh Desc"
    MyRs2.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N2 = MyRs2.RecordCount                                    ' n2: 条数
    With MSFlexGrid2
        .Clear
        .Top = MSFlexGrid1.Top + MSFlexGrid1.Height + 400
        .Rows = IIf(N2 + 2 < intRs2, intRs2, N2 + 2) + 1
        .Cols = 9
        .Height = 225 * (intRs2 + 1) + 90
        .Row = 0: .Col = 0: .Text = "序号":    .ColWidth(0) = 500
                  .Col = 1: .Text = "编号":    .ColWidth(1) = 500
                  .Col = 2: .Text = " 日期":    .ColWidth(2) = 1150
                  .Col = 3: .Text = "  名  称": .ColWidth(3) = 1690
                  .Col = 4: .Text = "  单价 ":  .ColWidth(4) = 860
                  .Col = 5: .Text = "数量":   .ColWidth(5) = 560
                  .Col = 6: .Text = "  收 入 ": .ColWidth(6) = 980
                  .Col = 7: .Text = "  支 出 ": .ColWidth(7) = 980
                  .Col = 8: .Text = "  备 注":  .ColWidth(8) = 1160 - IIf(.Rows > intRs2 + 1, 270, 0)
                   If N2 > 0 Then
                      ReDim arrZm(N2, 3)
                      MyRs2.MoveFirst
                      Srp = 0: Zcp = 0
                      Bhp = 0: m = 1
                      For i = 1 To N2
                          Rq = MyRs2![Rq]
                          Sz = MyRs2![Sz]
                          arrZm(i, 0) = MyRs2![Xh]                ' 暂存记录
                          arrZm(i, 1) = MyRs2![Sz]
                          arrZm(i, 2) = MyRs2![Lb]
                          arrZm(i, 3) = MyRs2![Rq]
                             If Bhp = MyRs2![Bh] Then
                                If m = 2 Then
                                  .Row = i
                                   For j = 1 To .Cols - 1
                                      .Col = j: .CellBackColor = intCx2                 ' 设置颜色
                                   Next
                                End If
                             Else
                                Bhp = MyRs2![Bh]
                                m = IIf(m = 1, 2, 1)
                                If m = 2 Then
                                  .Row = i
                                   For j = 1 To .Cols - 1
                                      .Col = j: .CellBackColor = intCx2                 ' 设置颜色
                                   Next
                                End If
                             End If
                         .TextMatrix(i, 0) = i & " "
                         .TextMatrix(i, 1) = MyRs2![Bh] & " "
                         .TextMatrix(i, 2) = " " & Rq
                         .TextMatrix(i, 3) = " " & MyRs2![Mc]
                         .TextMatrix(i, 4) = IIf(MyRs2![Dj] > 0, Format(MyRs2![Dj], "0.00 "), "")
                         .TextMatrix(i, 5) = IIf(MyRs2![Sl] > 0, MyRs2![Sl] & " ", "")
                         .TextMatrix(i, 6) = IIf(Sz = "s", Format(MyRs2![Sr], "0.00 "), "")
                         .TextMatrix(i, 7) = IIf(Sz = "z", Format(MyRs2![Zc], "0.00 "), "")
                         .TextMatrix(i, 8) = " " & MyRs2![Bz]
                          Srp = Srp + MyRs2![Sr]
                          Zcp = Zcp + MyRs2![Zc]
                          MyRs2.MoveNext
                      Next
                         .TextMatrix(i + 1, 2) = " 累计"
                         .TextMatrix(i + 1, 6) = IIf(Srp > 0, Format(Srp, "0.00 "), "")
                         .TextMatrix(i + 1, 7) = Format(Zcp, "0.00 ")
                   Else
                      MsgBox "  很抱歉，暂无相关记录 ...  ", 48, "  请注意"
                   End If
        .MergeCol(1) = True
        .MergeCells = flexMergeRestrictColumns                   ' 单元格合并
        .Visible = True
    End With
End Sub

Private Sub MSFlexGrid2_Click()                                   ' 汇总报销单
    If strFs <> "3" Then Exit Sub
    With MSFlexGrid2
'MsgBox .TextMatrix(.Row, 1)
         If Trim(.TextMatrix(.Row, 1)) = "" Then Exit Sub
         If Val(.TextMatrix(.Row, 1)) > 0 Then Exit Sub
         If Trim(.TextMatrix(.Row, 7)) = "" Then Exit Sub
        .Col = 1
         If .TextMatrix(.Row, 8) Like "*√*" Then
            .TextMatrix(.Row, 8) = ""
             For j = 1 To .Cols - 1
                .Col = j: .CellBackColor = intCy2                ' 颜色复原
             Next
             Text1(0) = " " & Val(Text1(0)) - 1
             Text1(1) = " " & Format(Val(Text1(1)) - Val(.TextMatrix(.Row, 7)), "0.00")
         Else
            .TextMatrix(.Row, 8) = " √"
             For j = 1 To .Cols - 1
                .Col = j: .CellBackColor = intCx2                ' 设置颜色
             Next
             Text1(0) = " " & Val(Text1(0)) + 1
             Text1(1) = " " & Format(Val(Text1(1)) + Val(.TextMatrix(.Row, 7)), "0.00")
         End If
         Command1.Enabled = True
         Command4.Enabled = True
         Command5.Enabled = True
    End With
End Sub

Private Sub Combo1_Click()                                       ' 选中一人
    strFs = "3"
       dm = arrXm(Combo1.ListIndex, 1)                           ' 代码 Dm
       Xm = arrXm(Combo1.ListIndex, 2)
    If Xm = "" Then
       strTj = strYf                                             ' 全部
    Else
       strTj = strYf & " And Mc Like '%" & Xm & "%'"
    End If
    Call P_grd2
    Command4.Enabled = True
    Command5.Enabled = False
    Call P_qtxt
    Text1(2).Enabled = True
    Text1(3).Enabled = True
End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)            ' 选中一笔报销单
    If KeyAscii = 13 Then Call MSFlexGrid1_Click
End Sub

Private Sub MSFlexGrid1_Click()                                  ' 选中一单
    With MSFlexGrid1
         If .Row > N3 Then Exit Sub
         strFs = "2"
         k = .Row
         Bhp = arrBh(k, 0)
         Bxp = arrBh(k, 1)
         Xmp = Trim(.TextMatrix(k, 1))
         Sjp = Trim(.TextMatrix(k, 2))
         Jep = Trim(.TextMatrix(k, 3))
         Combo1.Text = " " & Xmp
        .Row = intRo1
            For j = 1 To .Cols - 1
               .Col = j: .CellBackColor = intCy1                 ' 颜色复原
            Next
         intRo1 = k
        .Row = k
            For j = 1 To .Cols - 1
               .Col = j: .CellBackColor = intCx1                 ' 设置颜色
            Next
         Text1(0) = " " & Trim(.TextMatrix(k, 4))
         Text1(1) = " " & Trim(.TextMatrix(k, 3))
         Text1(2) = " " & Trim(.TextMatrix(k, 6))
         Text1(3) = " " & IIf(.TextMatrix(k, 5) Like "*√*", Trim(.TextMatrix(k, 7)), StrCrq)
         Label3 = "返款日期："
         Command2.Enabled = False
         Command4.Enabled = True
         Command5.Enabled = True
         Command7.Enabled = IIf(Trim(.TextMatrix(k, 5)) = "", True, False)
         strTj = strYf & " And Bh=" & Bhp & " And Mc Like '%" & Xmp & "%'"
         Call P_grd2
         Label4 = IIf(Bxp = "B", "已报销返款", "已汇总送交") & "的医药费单据："
         Command3.Enabled = False
         If Trim(.TextMatrix(k, 5)) = "" Then
            strTj = strYd & " And Bh=0 And Mc Like '%" & Xmp & "%'"
            m = 0: Call P_grd3
         End If
    End With
End Sub

Private Sub P_grd3()
    Set MyRs0 = New Recordset                                    ' T_zm 表
    StrSQL = "SELECT * FROM " & StrT2 & strTj & _
             " Order By Rq Desc,Xh Desc"
'MsgBox StrSQL
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N0 = MyRs0.RecordCount                                    ' n0: 条数
    If N0 < 1 Then
       
       Exit Sub
    End If
    With MSFlexGrid2
        .Height = 225 * (intRs1 + 1) + 90
        .ColWidth(8) = 1160 - IIf(.Rows > intRs1 + 1, 270, 0)
    End With
    With MSFlexGrid3
        .Clear
        .Rows = IIf(N0 + 2 < intRs3, intRs3, N0 + 2) + 1
        .Cols = 8
        .Height = 225 * (intRs3 + 1) + 90
        .Row = 0: .Col = 0: .Text = "序号":   .ColWidth(0) = 500
                  .Col = 1: .Text = " 日期":    .ColWidth(1) = 1150
                  .Col = 2: .Text = "  名  称": .ColWidth(2) = 2130
                  .Col = 3: .Text = "  单价 ":  .ColWidth(3) = 860