frmac_dailyresult.frm

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

'         Call SetGrid(lPage, ROW_GRID_START + LCount)
'         CllR.SetCurSheet lPage
'         CllR.SetRows ROW_GRID_START + ROWS_PAGE, lPage
'         CllR.SetCols COL_END + 2, lPage
'         i = ROW_GRID_START - 1
'         LCount = 0
'    End If
    lCount = lCount + 1
    i = i + 1
    If dYEyesterday_Money_total = 0 Then
        sFXyesterday_total = "平"
    ElseIf dYEyesterday_Money_total > 0 Then
        sFXyesterday_total = "借"
    Else
        sFXyesterday_total = "贷"
    End If
    If dYEtoday_Money_total = 0 Then
        sFXtoday_total = "平"
    ElseIf dYEtoday_Money_total > 0 Then
        sFXtoday_total = "借"
    Else
        sFXtoday_total = "贷"
    End If
    Call AppendOneRow(i, "合 计：", " ", sFXyesterday_total, Abs(dYEyesterday_Amount_total), Abs(dYEyesterday_Foreign_total), Abs(dYEyesterday_Money_total), _
        dDebitToday_Amount_total, dDebitToday_Foreign_total, dDebitToday_Money_total, dCreditToday_Amount_total, dCreditToday_Foreign_total, dCreditToday_Money_total, sFXtoday_total, Abs(dYEtoday_Amount_total), Abs(dYEtoday_Foreign_total), Abs(dYEtoday_Money_total))
    
    Call SetGrid(lPage + 1, ROW_GRID_START + lCount)
    Cllr.SetCurSheet 0
    For i = 1 To Cllr.GetTotalSheets
        Cllr.SetCellString COL_END, ROW_PAGENO, i - 1, "总 " + CStr(Cllr.GetTotalSheets) + " 页 第 " & CStr(i) & " 页"
        Cllr.SetSheetLabel i - 1, "第" & CStr(i) & "页"
    Next i
    fMainForm.MousePointer = vbDefault
    Me.Show
End Sub

'求科目名称
Private Sub GetSubjName(ByVal sSubjectCode As String, ByRef sKmmc As String, ByRef bEndkm As Boolean)
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    sSQL = "SELECT kmmc,isendkm FROM tZW_Km" & glo.sOperateYear & _
            " WHERE kmdm = '" & sSubjectCode & "'"
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not (.BOF And .EOF) Then
           If Not IsNull(.Fields("kmmc").value) Then
              sKmmc = Trim(.Fields("kmmc").value)
              bEndkm = IIf(.Fields("isendkm").value = -1, True, False)
           End If
        End If
    End With
    rstTemp.Close
    Set rstTemp = Nothing
End Sub

'求一个科目的今日共借金额
Private Sub GetDebitToday(ByVal sSubjectCode As String, ByVal bEndkm As Boolean, ByVal GetQueryStr, ByRef dJe As Double, ByRef dSl As Double _
              , ByRef dWb As Double)
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    If bEndkm Then
        sSQL = "SELECT SUM(A.je) je,sum(A.sl) sl, sum(A.wb) wb  FROM tZW_Pzsj" & glo.sOperateYear & "  A  " & _
                GetQueryStr & " AND A.fx = '借' AND A.kmdm = '" & sSubjectCode & "'"
    Else
        sSQL = "SELECT SUM(A.je) je,sum(A.sl) sl, sum(A.wb) wb  FROM tZW_Pzsj" & glo.sOperateYear & "  A  " & _
                GetQueryStr & " AND A.fx = '借' AND A.kmdm LIKE '" & sSubjectCode & "-%'"
    End If
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not (.BOF And .EOF) Then
            dJe = IIf(IsNull(.Fields(0).value), 0, .Fields(0).value)
            dSl = IIf(IsNull(.Fields(1).value), 0, .Fields(1).value)
            dWb = IIf(IsNull(.Fields(2).value), 0, .Fields(2).value)
        Else
            dJe = 0
            dSl = 0
            dWb = 0
        End If
        .Close
    End With
    Set rstTemp = Nothing
End Sub

'求一个科目的今日共贷金额
Private Sub GetCreditToday(ByVal sSubjectCode As String, ByVal bEndkm As Boolean, ByVal GetQueryStr, ByRef dJe As Double, ByRef dSl As Double _
              , ByRef dWb As Double)
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    If bEndkm Then
        sSQL = "SELECT SUM(A.je) je,sum(A.sl) sl, sum(A.wb) wb  FROM tZW_Pzsj" & glo.sOperateYear & "  A " & _
                GetQueryStr & " AND A.fx = '贷' AND A.kmdm = '" & sSubjectCode & "'"
    Else
        sSQL = "SELECT SUM(A.je) je,sum(A.sl) sl, sum(A.wb) wb  FROM tZW_Pzsj" & glo.sOperateYear & "  A " & _
               GetQueryStr & " AND A.fx = '贷' AND A.kmdm LIKE '" & sSubjectCode & "-%'"
    End If
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
         If Not (.BOF And .EOF) Then
            dJe = IIf(IsNull(.Fields(0).value), 0, .Fields(0).value)
            dSl = IIf(IsNull(.Fields(1).value), 0, .Fields(1).value)
            dWb = IIf(IsNull(.Fields(2).value), 0, .Fields(2).value)
         Else
            dJe = 0
            dSl = 0
            dWb = 0
         End If
        .Close
    End With
    Set rstTemp = Nothing
End Sub

'求一个科目的上月余额
Private Sub GetLastMonthBalance(ByVal sSubjectCode As String, ByRef bEndkm As Boolean, ByVal sMonth As String, ByRef sFx As String, dBalanceMoney As Double _
                                , ByRef dBalanceAmount As Double, ByRef dBalanceForeign)
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    Dim iMonth As Integer
    Dim sLastMonth As String
    Dim dJe As Double
    Dim dSl As Double
    Dim dWb As Double
    Dim sYefx As String
    iMonth = Month(sMonth)
    sLastMonth = Format(iMonth - 1, "00")
    sSQL = "SELECT  ljj" & sLastMonth & ",ljd" & sLastMonth & _
        " , ljjsl" & sLastMonth & ",ljdsl" & sLastMonth & _
        ", ljjwb" & sLastMonth & ",ljdwb" & sLastMonth & _
        ",yefx  FROM tZW_balance" & glo.sOperateYear & _
        " WHERE kmdm='" & sSubjectCode & "'"
        
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    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 GetThisMonthTotal(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 GetThisMonthTotal(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.sUnEarlierDate, "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.sUnEarlierDate, "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.sUnEarlierDate & "','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.sUnEarlierDate & "','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.sUnEarlierDate, "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.sUnEarlierDate, "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.sUnEarlierDate & "','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.sUnEarlierDate & "','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 GetLastMonthBalance1(ByVal sSubjectCode As String, ByRef bEndkm As Boolean, ByVal sMonth As String, ByRef sFx As String, dBalanceMoney As Double _
                                , ByRef dBalanceAmount As Double, ByRef dBalanceForeign)
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    Dim iMonth As Integer
    Dim sLastMonth As String
    Dim dJe As Double
    Dim dSl As Double
    Dim dWb As Double
    Dim sYefx As String
    iMonth = Month(sMonth)
    iMonth = 1
    sLastMonth = Format(iMonth - 1, "00")
    sSQL = "SELECT  ljj" & sLastMonth & ",ljd" & sLastMonth & _
        " , ljjsl" & sLastMonth & ",ljdsl" & sLastMonth & _
        ", ljjwb" & sLastMonth & ",ljdwb" & sLastMonth & _
        ",yefx  FROM tZW_balance" & glo.sOperateYear & _
        " WHERE kmdm='" & sSubjectCode & "'"
        
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient