frmac_dailyresult.frm

一个用VB写的财务软件源码

    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not (.EOF And .BOF) Then
          dBalanceMoney = .Fields(0).value - .Fields(1).value
          dBalanceAmount = .Fields(2).value - .Fields(3).value
          dBalanceForeign = .Fields(4).value - .Fields(5).value
          sYefx = .Fields("yefx").value
        Else
          dBalanceMoney = 0
          dBalanceAmount = 0
          dBalanceForeign = 0
        End If
        .Close
    End With
    Set rstTemp = Nothing
    
   '查一个科目从结帐月初到当前日的前一天的累计余额
    Call GetThisMonthTotal1(sSubjectCode, bEndkm, sMonth, dJe, dSl, dWb)
    If sYefx = "借方" Then
       dBalanceMoney = dBalanceMoney + dJe
       dBalanceAmount = dBalanceAmount + dSl
       dBalanceForeign = dBalanceForeign + dWb
    Else
       dBalanceMoney = dBalanceMoney - dJe
       dBalanceAmount = dBalanceAmount - dSl
       dBalanceForeign = dBalanceForeign - dWb
    End If
    sFx = Left(sYefx, 1)
End Sub

'查一个科目从本月初到当前日的前一天的累计余额
Private Sub GetThisMonthTotal1(ByVal sSubjectCode As String, ByVal bEndkm As Boolean, ByVal sdate As String, ByRef dJe As Double _
            , ByRef dSl As Double, ByRef dWb As Double)
    Dim iPeriod As Integer
    Dim sBeginDate As String
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    Dim dJf As Double, dDf As Double
    Dim dJwb As Double, dDwb As Double
    Dim dJsl As Double, dDsl As Double
    
    '取日期所在的会计期
    iPeriod = GetPeriod(sdate)
    '取该会计期的起始日期
    sBeginDate = (GetPeriodFrom(iPeriod))
    '求该科目的借、贷方合计
    Select Case g_FLAT
        Case "SQL"
            If bEndkm Then
                sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                    " WHERE pzrq>='" & Format(glo.sOperateYear & "-01-01", "yyyy-mm-dd") & "' AND kmdm = '" & sSubjectCode & _
                    "'  AND pzrq<'" & _
                    Format(sdate, "yyyy-mm-dd") & "' AND fx='借'"
            Else
                sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                    " WHERE pzrq>='" & Format(glo.sOperateYear & "-01-01", "yyyy-mm-dd") & "' AND kmdm LIKE '" & sSubjectCode & _
                    "-%'  AND pzrq<'" & _
                    Format(sdate, "yyyy-mm-dd") & "' AND fx='借'"
            End If
        Case "ORACLE"
            If bEndkm Then
               sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl  FROM tZW_pzsj" & glo.sOperateYear & _
                  " WHERE pzrq>=TO_DATE('" & glo.sOperateYear & "-01-01" & "','YYYY-MM-DD')" & " AND kmdm = '" & sSubjectCode & _
                  "' " & _
                  " AND pzrq<TO_DATE('" & sdate & "','YYYY-MM-DD')" & " AND fx='借'"
            Else
               sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl  FROM tZW_pzsj" & glo.sOperateYear & _
                   " WHERE pzrq>=TO_DATE('" & glo.sOperateYear & "-01-01" & "','YYYY-MM-DD')" & " AND kmdm LIKE '" & sSubjectCode & _
                   "-%' " & _
                   " AND pzrq<TO_DATE('" & sdate & "','YYYY-MM-DD')" & " AND fx='借'"
            End If
    End Select
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .BOF And .EOF Then
            dJf = 0
            dJsl = 0
            dJwb = 0
        Else
            dJf = IIf(IsNull(.Fields("je").value), 0, .Fields("je").value)
            dJsl = IIf(IsNull(.Fields("sl").value), 0, .Fields("sl").value)
            dJwb = IIf(IsNull(.Fields("wb").value), 0, .Fields("wb").value)
        End If
        .Close
        Select Case g_FLAT
            Case "SQL"
               If bEndkm Then
                    sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                        " WHERE pzrq>='" & Format(glo.sOperateYear & "-01-01", "yyyy-mm-dd") & "' AND kmdm = '" & sSubjectCode & _
                        "'  AND pzrq<'" & _
                        Format(sdate, "yyyy-mm-dd") & "' AND fx='贷'"
               Else
                    sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                        " WHERE pzrq>='" & Format(glo.sOperateYear & "-01-01", "yyyy-mm-dd") & "' AND kmdm LIKE '" & sSubjectCode & _
                        "-%'  AND pzrq<'" & _
                        Format(sdate, "yyyy-mm-dd") & "' AND fx='贷'"
               End If
            Case "ORACLE"
               If bEndkm Then
                    sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                        " WHERE pzrq>=TO_DATE('" & glo.sOperateYear & "-01-01" & "','YYYY-MM-DD')" & " AND kmdm = '" & sSubjectCode & _
                        "' " & _
                        " AND pzrq<TO_DATE('" & sdate & "','YYYY-MM-DD')" & " AND fx='贷'"
               Else
                    sSQL = "SELECT sum(je) je, sum(wb) wb, sum(sl) sl FROM tZW_pzsj" & glo.sOperateYear & _
                        " WHERE pzrq>=TO_DATE('" & glo.sOperateYear & "-01-01" & "','YYYY-MM-DD')" & " AND kmdm LIKE '" & sSubjectCode & _
                        "-%' " & _
                        " AND pzrq<TO_DATE('" & sdate & "','YYYY-MM-DD')" & " AND fx='贷'"
              End If
        End Select
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .BOF And .EOF Then
            dDf = 0
            dDsl = 0
            dDwb = 0
        Else
            dDf = IIf(IsNull(.Fields("je").value), 0, .Fields("je").value)
            dDsl = IIf(IsNull(.Fields("sl").value), 0, .Fields("sl").value)
            dDwb = IIf(IsNull(.Fields("wb").value), 0, .Fields("wb").value)
        End If
        .Close
    End With
    '求余额
    dJe = dJf - dDf
    dWb = dJwb - dDwb
    dSl = dJsl - dDsl
End Sub


'重画金额式表格
Private Sub DoRedrawCellHeadDefault(ByVal iColWidth As Variant)
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim i As Integer
    Dim j As Integer
    
    With Cllr
        iTotalPages = .GetTotalSheets
        lCurrentPage = .GetCurSheet
        For i = 0 To iTotalPages
            .SetCurSheet i
            For j = LBound(iColWidth) To UBound(iColWidth)
                .SetColWidth 1, iColWidth(j), j, i
            Next j
            
            .MergeCells COL_BEGIN_BALANCE_MONEY, ROW_HEAD1, COL_BEGIN_BALANCE_MONEY, ROW_HEAD2
            .MergeCells COL_HAPPEN_DEBIT_MONEY, ROW_HEAD1, COL_HAPPEN_CREDIT_MONEY, ROW_HEAD1
            .MergeCells COL_END_BALANCE_MONEY, ROW_HEAD1, COL_END_BALANCE_MONEY, ROW_HEAD2
            
            .SetCellString COL_BEGIN_BALANCE_MONEY, ROW_HEAD1, i, "昨日余额"
            .SetCellString COL_HAPPEN_DEBIT_MONEY, ROW_HEAD1, i, "今日金额发生"
            .SetCellString COL_HAPPEN_DEBIT_MONEY, ROW_HEAD2, i, "借方"
            .SetCellString COL_HAPPEN_CREDIT_MONEY, ROW_HEAD2, i, "贷方"
            .SetCellString COL_END_BALANCE_MONEY, ROW_HEAD1, i, "今日余额"
        Next i
        .SetCurSheet lCurrentPage
    End With
End Sub

'根据选择的账页格式重画表格的页头
Private Sub DoRedrawCellHead(ByVal iColWidth As Variant, _
            ByVal iCol_Begin_Balance_StartCol As Integer, ByVal iCol_Begin_Balance_EndCol, _
            ByVal iCol_Happen_Debit_StartCol As Integer, ByVal iCol_Happen_Debit_EndCol As Integer, _
            ByVal iCol_Happen_Credit_StartCol As Integer, ByVal iCol_Happen_Credit_EndCol, _
            ByVal iCol_End_Balance_StartCol As Integer, ByVal iCol_End_Balance_EndCol As Integer, _
            ByVal iRow_Start As Integer, ByVal iRow_End As Integer)
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim i As Integer
    Dim j As Integer
    
    With Cllr
        iTotalPages = .GetTotalSheets
        lCurrentPage = .GetCurSheet
        For i = 0 To iTotalPages
            .SetCurSheet i
            For j = LBound(iColWidth) To UBound(iColWidth)
               .SetColWidth 1, iColWidth(j), j, i
            Next j
            .MergeCells iCol_Begin_Balance_StartCol, iRow_Start, iCol_Begin_Balance_EndCol, iRow_End
            .MergeCells iCol_Happen_Debit_StartCol, iRow_Start, iCol_Happen_Debit_EndCol, iRow_End
            .MergeCells iCol_Happen_Credit_StartCol, iRow_Start, iCol_Happen_Credit_EndCol, iRow_End
            .MergeCells iCol_End_Balance_StartCol, iRow_Start, iCol_End_Balance_EndCol, iRow_End
            
            .SetCellString iCol_Begin_Balance_StartCol, iRow_Start, i, "昨日余额"
            .SetCellString iCol_Happen_Debit_StartCol, iRow_Start, i, "今日借方发生"
            .SetCellString iCol_Happen_Credit_StartCol, iRow_Start, i, "今日贷方发生"
            .SetCellString iCol_End_Balance_StartCol, iRow_Start, i, "今日余额"
            .SetCellString COL_BEGIN_BALANCE_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_BEGIN_BALANCE_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_BEGIN_BALANCE_MONEY, ROW_HEAD2, i, "金额"
            
            .SetCellString COL_HAPPEN_DEBIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_HAPPEN_DEBIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_HAPPEN_DEBIT_MONEY, ROW_HEAD2, i, "金额"
            .SetCellString COL_HAPPEN_CREDIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_HAPPEN_CREDIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_HAPPEN_CREDIT_MONEY, ROW_HEAD2, i, "金额"
            
            .SetCellString COL_END_BALANCE_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_END_BALANCE_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_END_BALANCE_MONEY, ROW_HEAD2, i, "金额"
        Next i
        .SetCurSheet lCurrentPage
    End With
End Sub

Private Sub AppendOneRow(ByVal i As Long, ByVal sSubjectCode As String, _
        ByVal sSubjectName As String, ByVal sBegin_Direction As String, _
        ByVal dBegin_Balance_Amount As Double, ByVal dBegin_Balance_Foreign As Double, _
        ByVal dBegin_Balance_Money As Double, ByVal dHappen_Debit_Amount As Double, _
        ByVal dHappen_Debit_Foreign As Double, ByVal dHappen_Debit_Money As Double, _
        ByVal dHappen_Credit_Amount As Double, ByVal dHappen_Credit_Foreign As Double, _
        ByVal dHappen_Credit_Money As Double, ByVal sEnd_Direction As String, _
        ByVal dEnd_Balance_Amount As Double, ByVal dEnd_Balance_Foreign As Double, _
        ByVal dEnd_Balance_Money As Double)
    
    With Cllr
        .SetCellString COL_SUBJECTCODE, i, .GetCurSheet, sSubjectCode
        .SetCellString COL_SUBJECTNAME, i, .GetCurSheet, sSubjectName
        '昨日余额
        .SetCellString COL_BEGIN_DIRECTION, i, .GetCurSheet, sBegin_Direction
        
      If Abs(dBegin_Balance_Amount) > 0.0001 Then
        .SetCellDouble COL_BEGIN_BALANCE_AMOUNT, i, .GetCurSheet, dBegin_Balance_Amount
      End If
      If Abs(dBegin_Balance_Foreign) > 0.0001 Then
        .SetCellDouble COL_BEGIN_BALANCE_FOREIGN, i, .GetCurSheet, dBegin_Balance_Foreign
      End If
      If Abs(dBegin_Balance_Money) > 0.0001 Then
        .SetCellDouble COL_BEGIN_BALANCE_MONEY, i, .GetCurSheet, dBegin_Balance_Money
      End If
      '今日发生
      If Abs(dHappen_Debit_Amount) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_DEBIT_AMOUNT, i, .GetCurSheet, dHappen_Debit_Amount
      End If
      If Abs(dHappen_Debit_Foreign) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_DEBIT_FOREIGN, i, .GetCurSheet, dHappen_Debit_Foreign
      End If
      If Abs(dHappen_Debit_Money) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_DEBIT_MONEY, i, .GetCurSheet, dHappen_Debit_Money
      End If
      If Abs(dHappen_Credit_Amount) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_CREDIT_AMOUNT, i, .GetCurSheet, dHappen_Credit_Amount
      End If
      If Abs(dHappen_Credit_Foreign) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_CREDIT_FOREIGN, i, .GetCurSheet, dHappen_Credit_Foreign
      End If
      If Abs(dHappen_Credit_Money) > 0.0001 Then
        .SetCellDouble COL_HAPPEN_CREDIT_MONEY, i, .GetCurSheet, dHappen_Credit_Money
      End If
      '今日余额
       .SetCellString COL_END_DIRECTION, i, .GetCurSheet, sEnd_Direction
      If Abs(dEnd_Balance_Amount) > 0.0001 Then
        .SetCellDouble COL_END_BALANCE_AMOUNT, i, .GetCurSheet, dEnd_Balance_Amount
      End If
      If Abs(dEnd_Balance_Foreign) > 0.0001 Then
        .SetCellDouble COL_END_BALANCE_FOREIGN, i, .GetCurSheet, dEnd_Balance_Foreign
      End If
      If Abs(dEnd_Balance_Money) > 0.0001 Then
        .SetCellDouble COL_END_BALANCE_MONEY, i, .GetCurSheet, dEnd_Balance_Money
      End If
    End With
End Sub

Public Sub uDetailResult()
    Call cllR_mousedclick(m_iCol, m_iRow)
End Sub
Public Sub uBookResult()
    Dim frmR As New frmAC_BookResult
    Dim sSubjCode As String
    Dim sSubjName As String
    Dim i As Integer
    
    sSubjCode = Trim(Cllr.GetCellString(1, m_iRow, Cllr.GetCurSheet))
    sSubjName = Trim(Cllr.GetCellString(2, m_iRow, Cllr.GetCurSheet))
    If sSubjCode = "" Or sSubjCode = "合 计：" Then Exit Sub
    '判断是否为日记账科目
    Dim rSt As ADODB.Recordset
    Set rSt = New ADODB.Recordset
    rSt.CursorLocation = adUseClient
    Dim sSQL As String
    With rSt
        sSQL = "select kmdm,kmmc from tZW_km" & glo.sOperateYear & _
            " where kmdm='" & sSubjCode & "' and isrjz=-1 order by kmdm"
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If (.EOF And .BOF) Then
           MsgBox "(" & sSubjCode & ")" & sSubjName & "为非日记账科目，不能进行日记账