frmac_dailyresult.frm

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

            
            .SetCellNumType COL_END_BALANCE_MONEY, i, PageNo - 1, 1
            .SetCellSeparator COL_END_BALANCE_MONEY, i, PageNo - 1, 2
            .SetCellDigital COL_END_BALANCE_MONEY, i, PageNo - 1, 2
            .SetCellAlign COL_END_BALANCE_MONEY, i, PageNo - 1, 32 + 2
        Next i
        '合并右边框线
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
    'Draw Line
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_SUBJECTCODE, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_SUBJECTNAME, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)

    'Print Corp & Date & Time
        .SetRows .GetRows(PageNo - 1) + 1, PageNo - 1
        i = .GetRows(PageNo - 1) - 1
        .MergeCells COL_START, i, COL_HAPPEN_DEBIT_FOREIGN, i
        .MergeCells COL_HAPPEN_DEBIT_MONEY, i, COL_END, i
        .SetCellAlign COL_START, i, PageNo - 1, 33
        .SetCellAlign COL_HAPPEN_DEBIT_MONEY, i, PageNo - 1, 34
        .SetCellFont COL_START, i, PageNo - 1, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_START, i, PageNo - 1, 10
        .SetCellFontStyle COL_START, i, PageNo - 1, 0
        .SetCellFont COL_HAPPEN_DEBIT_MONEY, i, PageNo - 1, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_HAPPEN_DEBIT_MONEY, i, PageNo - 1, 10
        .SetCellFontStyle COL_HAPPEN_DEBIT_MONEY, i, PageNo - 1, 0
        .SetCellString COL_START, i, PageNo - 1, "核算单位：" & GetEnterpriseName("")
        .SetCellString COL_HAPPEN_DEBIT_MONEY, i, PageNo - 1, "( 打印日期：" & Format(Date, "yyyy-mm-dd") & _
                    "    时间：" & Format(Time, "hh:MM:ss") & " )"
        .ShowPageBreak False
    End With

End Sub

Public Sub ShowResult()
    Dim sSQL As String
    Dim sQueryStr As String
    Dim sQueryStr_Result
    Dim rstSubject As ADODB.Recordset
    '---------------------------------------------------
    Dim sFXyesterday As String                  '昨日余额方向
    Dim dYEyesterday_Money As Double            '昨日余额
    Dim dYEyesterday_Amount As Double
    Dim dYEyesterday_Foreign As Double
    
    Dim dDebitToday_Money As Double                   '今日共借
    Dim dDebitToday_Amount As Double                  '今日共借
    Dim dDebitToday_Foreign As Double                 '今日共借
    
    Dim dCreditToday_Money As Double                       '今日共贷
    Dim dCreditToday_Amount As Double                       '今日共贷
    Dim dCreditToday_Foreign As Double                       '今日共贷
    
    Dim sFXtoday As String                      '今日余额方向
    Dim dYEtoday_Money As Double                '今日余额
    Dim dYEtoday_Amount As Double
    Dim dYEtoday_Foreign As Double
    '-------------------------------------------------------
    Dim sFXyesterday_total As String                  '昨日余额方向合计
    Dim dYEyesterday_Money_total As Double            '昨日余额合计
    Dim dYEyesterday_Amount_total As Double
    Dim dYEyesterday_Foreign_total As Double
    
    Dim dDebitToday_Money_total As Double                   '今日共借合计
    Dim dDebitToday_Amount_total As Double                  '今日共借
    Dim dDebitToday_Foreign_total As Double                 '今日共借
    
    Dim dCreditToday_Money_total As Double                       '今日共贷
    Dim dCreditToday_Amount_total As Double                       '今日共贷
    Dim dCreditToday_Foreign_total As Double                       '今日共贷
    
    Dim sFXtoday_total As String                      '今日余额方向
    Dim dYEtoday_Money_total As Double                '今日余额
    Dim dYEtoday_Amount_total As Double
    Dim dYEtoday_Foreign_total As Double
    
    Dim i As Long, lCount As Long, lPage As Long
    Dim j As Long
    Dim L As Integer
    Dim sSubjCode As String
    Dim sSubjName As String
    
    Dim m_sKmCode() As String
    Dim m As Integer
    Dim n As Integer
    
    Dim bFound As Boolean
    Dim bTemp As Boolean
    Dim bEndkm As Boolean           '是否为末级科目
   
    fMainForm.MousePointer = vbHourglass
    lPage = 0
    i = ROW_GRID_START - 1
    lCount = 0

    '查询本日科目
    If m_sSubjCodeStart <> "" And m_sSubjCodeEnd <> "" Then         '选择科目
        Select Case g_FLAT
            Case "SQL"
'                sQueryStr = " WHERE kjqj = " & m_sMonth & _
                            " AND pzrq ='" & Format(m_sDate, "yyyy-mm-dd") & "'"
                sQueryStr = " WHERE kjqj = " & m_sMonth & _
                            " AND pzrq ='" & Format(m_sDate, "yyyy-mm-dd") & "'"
            Case "ORACLE"
                sQueryStr = " WHERE kjqj = " & m_sMonth & _
                            " AND pzrq =TO_DATE('" & m_sDate & "','YYYY-MM-DD')"
        End Select
        '如果选择包括未记账凭证
        If m_bUnCheck Then
            sQueryStr = sQueryStr & " AND xgbz <= '2'"
        Else
            sQueryStr = sQueryStr & " AND xgbz = '2'"
        End If
        If IsEndSubject(m_sSubjCodeEnd) Then
         sQueryStr_Result = sQueryStr & " AND ((kmdm >=  '" & m_sSubjCodeStart & "' and kmdm < '" & m_sSubjCodeEnd & "') or kmdm = '" & m_sSubjCodeEnd & "' )"
       
        Else
        sQueryStr_Result = sQueryStr & " AND ((kmdm >=  '" & m_sSubjCodeStart & "' and kmdm < '" & m_sSubjCodeEnd & "') or kmdm LIKE '" & m_sSubjCodeEnd & "-%' )"
        End If
        sSQL = "SELECT DISTINCT kmdm SubjCode FROM tZW_Pzsj" & glo.sOperateYear & sQueryStr_Result
        sSQL = sSQL & " ORDER BY kmdm "
    ElseIf m_sSubjCodeStart <> "" And m_sSubjCodeEnd = "" Then
           Select Case g_FLAT
            Case "SQL"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq ='" & Format(m_sDate, "yyyy-mm-dd") & "'"
            Case "ORACLE"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq =TO_DATE('" & m_sDate & "','YYYY-MM-DD')"
            End Select
            '如果选择包括未记账凭证
            If m_bUnCheck Then
                sQueryStr = sQueryStr & " AND A.xgbz <= '2'"
            Else
                sQueryStr = sQueryStr & " AND A.xgbz = '2'"
            End If
           sQueryStr_Result = sQueryStr & " AND kmdm >=  '" & m_sSubjCodeStart & "' "
           sSQL = "SELECT DISTINCT A.kmdm SubjCode FROM tZW_Pzsj" & glo.sOperateYear & " A  " & sQueryStr_Result
           sSQL = sSQL & " ORDER BY 1"
     ElseIf m_sSubjCodeStart = "" And m_sSubjCodeEnd <> "" Then
           Select Case g_FLAT
            Case "SQL"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq ='" & Format(m_sDate, "yyyy-mm-dd") & "'"
            Case "ORACLE"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq =TO_DATE('" & m_sDate & "','YYYY-MM-DD')"
            End Select
            '如果选择包括未记账凭证
            If m_bUnCheck Then
                sQueryStr = sQueryStr & " AND A.xgbz <= '2'"
            Else
                sQueryStr = sQueryStr & " AND A.xgbz = '2'"
            End If
             If IsEndSubject(m_sSubjCodeEnd) Then
              sQueryStr_Result = sQueryStr & " AND ( kmdm < '" & m_sSubjCodeEnd & "' or kmdm= '" & m_sSubjCodeEnd & "' )"
          
             Else
           sQueryStr_Result = sQueryStr & " AND ( kmdm < '" & m_sSubjCodeEnd & "' or kmdm LIKE '" & m_sSubjCodeEnd & "-%' )"
             End If
           sSQL = "SELECT DISTINCT kmdm SubjCode FROM tZW_Pzsj" & glo.sOperateYear & " A " & sQueryStr_Result
           sSQL = sSQL & " ORDER BY kmdm "
    Else
           Select Case g_FLAT
            Case "SQL"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq ='" & Format(m_sDate, "yyyy-mm-dd") & "'"
            Case "ORACLE"
                sQueryStr = " WHERE A.kjqj = " & m_sMonth & _
                            " AND A.pzrq =TO_DATE('" & m_sDate & "','YYYY-MM-DD')"
            End Select
            '如果选择包括未记账凭证
            If m_bUnCheck Then
                sQueryStr = sQueryStr & " AND A.xgbz <= '2'"
            Else
                sQueryStr = sQueryStr & " AND A.xgbz = '2'"
            End If
            sQueryStr_Result = sQueryStr
            sSQL = "SELECT DISTINCT kmdm SubjCode FROM tZW_Pzsj" & glo.sOperateYear & " A " & sQueryStr_Result
            sSQL = sSQL & " ORDER BY kmdm"
    End If
    m = 1
   
    '取得科目范围,并且存放到数组中
       Set rstSubject = New ADODB.Recordset
       rstSubject.CursorLocation = adUseClient
         ReDim Preserve m_sKmCode(1)
         With rstSubject
             .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
             If Not (.EOF And .BOF) Then
                 .MoveFirst
                 Do Until .EOF
                   sSubjCode = Trim$("" & .Fields("SubjCode").value)
                   bTemp = False
                   For n = 1 To Len(sSubjCode)
                      If Mid(sSubjCode, n, 1) = glo.sSeparateSubject Then
                         For L = LBound(m_sKmCode) To UBound(m_sKmCode)
                             If Trim(m_sKmCode(L)) = Left(sSubjCode, n - 1) Then
                                bFound = True
                                Exit For
                             End If
                         Next L
                         If Not bFound Then
                            m_sKmCode(m) = Left(sSubjCode, n - 1)
                            m = m + 1
                            ReDim Preserve m_sKmCode(m)
                         Else
                           bFound = False
                         End If
                      End If
                   Next n
                   m_sKmCode(m) = sSubjCode
                   m = m + 1
                   ReDim Preserve m_sKmCode(m)
                   .MoveNext
                 Loop
            End If
         .Close
        End With
        Set rstSubject = Nothing
        
        For m = LBound(m_sKmCode) To UBound(m_sKmCode)
           If m_sKmCode(m) <> "" Then
                i = i + 1
                lCount = lCount + 1
                sSubjCode = Trim$(m_sKmCode(m))
                Call GetSubjName(sSubjCode, sSubjName, bEndkm)
                '取得昨天的余额
                Call GetLastMonthBalance1(sSubjCode, bEndkm, CDate(m_sDate), sFXyesterday, dYEyesterday_Money, dYEyesterday_Amount, dYEyesterday_Foreign)
                If dYEyesterday_Money = 0 Then
                    sFXyesterday = "平"
                ElseIf dYEyesterday_Money > 0 Then
                    sFXyesterday = "借"
                Else
                    sFXyesterday = "贷"
                End If
                
                Call GetDebitToday(sSubjCode, bEndkm, sQueryStr, dDebitToday_Money, dDebitToday_Amount, dDebitToday_Foreign)
                Call GetCreditToday(sSubjCode, bEndkm, sQueryStr, dCreditToday_Money, dCreditToday_Amount, dCreditToday_Foreign)
                
                dYEtoday_Money = dYEyesterday_Money + dDebitToday_Money - dCreditToday_Money
                dYEtoday_Amount = dYEyesterday_Amount + dDebitToday_Amount - dCreditToday_Amount
                dYEtoday_Foreign = dYEyesterday_Foreign + dDebitToday_Foreign - dCreditToday_Foreign
                
                If dYEtoday_Money = 0 Then
                    sFXtoday = "平"
                ElseIf dYEtoday_Money > 0 Then
                    sFXtoday = "借"
                Else
                    sFXtoday = "贷"
                End If
                
                If GetKmJc(Trim(sSubjCode)) = 0 Or m = LBound(m_sKmCode) Then
                     dYEyesterday_Money_total = dYEyesterday_Money_total + dYEyesterday_Money
                     dYEyesterday_Amount_total = dYEyesterday_Amount_total + dYEyesterday_Amount
                     dYEyesterday_Foreign_total = dYEyesterday_Foreign_total + dYEyesterday_Foreign
                    
                     dDebitToday_Money_total = dDebitToday_Money_total + dDebitToday_Money
                     dDebitToday_Amount_total = dDebitToday_Amount_total + dDebitToday_Amount
                     dDebitToday_Foreign_total = dDebitToday_Foreign_total + dDebitToday_Foreign
                    
                     dCreditToday_Money_total = dCreditToday_Money_total + dCreditToday_Money
                     dCreditToday_Amount_total = dCreditToday_Amount_total + dCreditToday_Amount
                     dCreditToday_Foreign_total = dCreditToday_Foreign_total + dCreditToday_Foreign
                     
                     dYEtoday_Money_total = dYEtoday_Money_total + dYEtoday_Money
                     dYEtoday_Amount_total = dYEtoday_Amount_total + dYEtoday_Amount
                     dYEtoday_Foreign_total = dYEtoday_Foreign_total + dYEtoday_Foreign
                End If
                
                Call AppendOneRow(i, sSubjCode, sSubjName, sFXyesterday, Abs(dYEyesterday_Amount), Abs(dYEyesterday_Foreign), Abs(dYEyesterday_Money), _
                        dDebitToday_Amount, dDebitToday_Foreign, dDebitToday_Money, dCreditToday_Amount, dCreditToday_Foreign, dCreditToday_Money, sFXtoday, Abs(dYEtoday_Amount), Abs(dYEtoday_Foreign), Abs(dYEtoday_Money))
                
                If (lCount Mod ROWS_PAGE = 0) Then
                    lPage = lPage + 1
                    Cllr.InsertSheet Cllr.GetTotalSheets, 1
                    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
         End If
      Next m
      
    '求合计行

'    If (LCount Mod ROWS_PAGE = 0) Then
'         lPage = lPage + 1
'         CllR.InsertSheet CllR.GetTotalSheets, 1