frmac_detailresult.frm

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

                Else
                    iMonth = 0
                    iDay = 0
                End If
                If .Fields("FX").value = "借" Then
                    Call AppendOneRow(ROW_GRID_START + lCount - 1, CurRow - ROW_GRID_START + 1, _
                        iMonth, iDay, .Fields("pzzl").value, _
                        .Fields("pzbh").value, FormatToString(.Fields("yhdz_bill").value), Trim$("" & .Fields("pzzy").value), _
                        .Fields("dj").value, .Fields("hl").value, sFX, IIf(sFX = "借", dbnYESL, -dbnYESL), _
                        IIf(sFX = "借", dbnYEWB, -dbnYEWB), IIf(sFX = "借", dbnYE, -dbnYE), _
                        Trim$("" & .Fields("zdrm").value), dDebit_Amount:=.Fields("sl").value, _
                        dDebit_Foreign:=.Fields("wb").value, dDebit_Money:=.Fields("je").value)
                Else
                    Call AppendOneRow(ROW_GRID_START + lCount - 1, CurRow - ROW_GRID_START + 1, _
                        iMonth, iDay, .Fields("pzzl").value, _
                        .Fields("pzbh").value, FormatToString(.Fields("yhdz_bill").value), Trim$("" & .Fields("pzzy").value), _
                        .Fields("dj").value, .Fields("hl").value, sFX, IIf(sFX = "借", dbnYESL, -dbnYESL), _
                        IIf(sFX = "借", dbnYEWB, -dbnYEWB), IIf(sFX = "借", dbnYE, -dbnYE), _
                        Trim$("" & .Fields("zdrm").value), dCredit_Amount:=.Fields("sl").value, _
                        dCredit_Foreign:=.Fields("wb").value, dCredit_Money:=.Fields("je").value)
                End If
                PreKjqj = CurKjqj
               
                If CInt(.Fields("xgbz").value) <> 2 Then
                   bNotRecord = True
                Else
                   bNotRecord = False
                End If
            
                If bNotRecord Then
                    n = ROW_GRID_START + lCount - 1
                    For m = 0 To Cllr.GetCols(Cllr.GetCurSheet) - 1
''                        CllR.DoSetCellColor m, N, lForeColour, lBackColour
                        Cllr.SetCellTextColor m, n, Cllr.GetCurSheet, Cllr.FindColorIndex(lForeColour, 1)
                        Cllr.SetCellBackColor m, n, Cllr.GetCurSheet, Cllr.FindColorIndex(lBackColour, 1)
                    Next m
                End If
                
                .MoveNext
            Loop
            .Close
            If PreKjqj = 0 Then
                PopVar dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB
                AddYearBeginRow dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB, CurRow, lCount
            Else
                
                Call AppendTotalRowsbak(PreKjqj)
                lCount = lCount - 1
                CurRow = CurRow - 1
            End If
        Else
            PopVar dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB
            AddYearBeginRow dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB, CurRow, lCount
            CurRow = CurRow + 1
            lCount = lCount + 1
        End If
    End With
    
'-----------------------------------------------
    Call SetGrid(lPage + 1, ROW_GRID_START + lCount)
    Cllr.SetCurSheet 0
    Cllr.Visible = True
    For i = 1 To Cllr.GetTotalSheets
       Cllr.SetSheetLabel i - 1, "第" & i & "页"
    Next i
    '为了防止装填账页格式时触发cboaccountformat_click事件时，出现系统提示账页格式已改变；
    '所以将此程序在此调用
    Call SetAccountFormat(cboAccountFormat, m_bAmount, m_bForeign)
    SetDefaultFormat m_sCurSubjectCode
    fMainForm.MousePointer = vbDefault
    Me.Show
    
End Sub


Public Sub ShowResult()
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    
    Dim sTemp As String                 '临时存放科目代码
    Dim PreStartOfMonth As String       '查询起始月份的上一个月
    Dim PreKjqj As Integer              '当前凭证的上一张凭证的会计期间
    Dim CurKjqj As Integer              '当前凭证会计期间
    Dim i As Integer
    Dim tmpVal As Double
    
    Dim iMonth As Integer
    Dim iDay As Integer
    
    '得到当前账套的单位名称
    m_sEnterName = GetDWMC
    If m_sEnterName = "" Then
        Exit Sub
    End If
    
    '初始化变量
    bnljJ = 0
    bnljJSL = 0
    bnljJWB = 0
    bnljD = 0
    bnljDSL = 0
    bnljDWB = 0
    
    
    
    fMainForm.MousePointer = vbHourglass
  '设置当前科目名称和代码
    m_sCurSubjectCode = arySubDetail(cboSubject.ListIndex + 1).sSubjectCode
    m_sCurSubjectName = arySubDetail(cboSubject.ListIndex + 1).sSubjectName
    If m_sCurSubjectCode = "" Then
       fMainForm.MousePointer = vbDefault
       MsgBox m_sSubjectCodeStart & "科目不存在，或者为日记账科目,不能联查明细账！", vbInformation
       Unload Me
    End If
    
    '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
    Cllr.Visible = False

    Cllr.ResetContent
    '清除CELL控件内容后，必须重新设置CELL的行数和列数；
    Cllr.SetCols COL_END + 2, 0
    Cllr.SetRows ROW_GRID_START + ROWS_PAGE, 0

    '得到打印时显示的科目代码和名称以及明细账科目
    m_sPrintSubjectCode = m_sCurSubjectCode
    m_sPrintSubjectName = GetSubjectFullPath(glo.sAccountID, m_sCurSubjectCode)
    
    
    If InStr(1, m_sPrintSubjectName, "\") > 0 Then
        m_sGeneralSubjectName = Mid(m_sPrintSubjectName, 1, InStr(1, m_sPrintSubjectName, "\") - 1)
    Else
        m_sGeneralSubjectName = m_sPrintSubjectName
    End If
    
    '得到一个科目数量单位和外币单位
    Call GetSldwAndWbdw(m_sCurSubjectCode, m_sSldw, m_sWbdw)
    If m_sSldw <> "" Then
        m_bAmount = True
    Else
        m_bAmount = False
    End If
    If m_sWbdw <> "" Then
        m_bForeign = True
    Else
        m_bForeign = False
    End If
        
    CurRow = ROW_GRID_START - 1
    lCount = 0
    lPage = 0
    
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    
    
'如果查询开始月份为一月份, 则计算上年结转余额;
'否则计算上月余额;
    If m_sFromMonth = 0 Then
        PreStartOfMonth = "00"
    Else
        PreStartOfMonth = Format(Val(m_sFromMonth) - 1, "00")
    End If

    '查询求年初数(00)、上月数(PreStartOfMonth)
    'JFSL00     JFWB00      JF00        DFSL00      DFWB00      DF00
    'JFSL01     JFWB01      JF01        DFSL01      DFWB01      DF01
    sSQL = "SELECT  ljjsl00 JFSL00,ljjwb00 JFWB00,ljj00 JF00," & _
            "ljdsl00 DFSL00,ljdwb00 DFWB00,ljd00 DF00," & _
            "ljjsl" & PreStartOfMonth & " JFSL01,ljjwb" & PreStartOfMonth & _
            " JFWB01,ljj" & PreStartOfMonth & " JF01," & _
            "ljdsl" & PreStartOfMonth & " DFSL01,ljdwb" & PreStartOfMonth & _
            " DFWB01,ljd" & PreStartOfMonth & " DF01" & _
            " FROM tZW_balance" & m_sYear & _
            " WHERE kmdm='" & m_sCurSubjectCode & "'"
  
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not .EOF Then
        dbnYESL = .Fields("JFSL01").value - .Fields("DFSL01").value
        dbnYEWB = .Fields("JFWB01").value - .Fields("DFWB01").value
        dbnYE = .Fields("JF01").value - .Fields("DF01").value
        
       
        bnljJ = .Fields("JF01").value - .Fields("JF00").value
        bnljD = .Fields("DF01").value - .Fields("DF00").value
        bnljJSL = .Fields("JFSL01").value - .Fields("JFSL00").value
        bnljDSL = .Fields("DFSL01").value - .Fields("DFSL00").value
        bnljJWB = .Fields("JFWB01").value - .Fields("JFWB00").value
        bnljDWB = .Fields("DFWB01").value - .Fields("DFWB00").value
       End If
        PushVar dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB
        
        .Close
    End With
    If dbnYE > 0 Then
        sFX = "借"
    ElseIf dbnYE = 0 Then
        sFX = "平"
    Else
        sFX = "贷"
    End If

'-------------------------------------------------
'从凭证表中取出记录进行处理
'取出的字段：会计期间、凭证种类、编号、日期、摘要、方向、金额、外币、汇率、制单人名
'2002.10.19 Add iif
If IsEndSubject(m_sCurSubjectCode) Then
sSQL = "SELECT kjqj,pzzl,pzbh,pzrq,pzzy,fx,je,sl,dj,wb,hl,zdrm,yhdz_bill" & _
            " FROM tZW_pzsj" & m_sYear & _
            " WHERE kjqj >= " & Val(m_sFromMonth) & _
            " AND kjqj <= " & Val(m_sToMonth) & _
            " AND  kmdm = '" & Trim(m_sCurSubjectCode) & "'" & _
            " AND (xgbz='2' or Kjqj=0)" & _
            IIf(m_sZY <> "", " and pzzy like '%" + m_sZY + "%'", "") & _
            IIf(StartJe <> 0, " and je >=" + CStr(StartJe), "") & _
            IIf(EndJe <> 0, " and je<=" + CStr(EndJe), "") & _
            " ORDER BY pzrq,pzzl,pzbh,jlhm"
    Else
    sSQL = "SELECT kjqj,pzzl,pzbh,pzrq,pzzy,fx,je,sl,dj,wb,hl,zdrm,yhdz_bill" & _
            " FROM tZW_pzsj" & m_sYear & _
            " WHERE kjqj >= " & Val(m_sFromMonth) & _
            " AND kjqj <= " & Val(m_sToMonth) & _
            " AND  kmdm like '" & Trim(m_sCurSubjectCode) & "-%'" & _
            " AND (xgbz='2' or Kjqj=0)" & _
            IIf(m_sZY <> "", " and pzzy like '%" + m_sZY + "%'", "") & _
            IIf(StartJe <> 0, " and je >=" + CStr(StartJe), "") & _
            IIf(EndJe <> 0, " and je<=" + CStr(EndJe), "") & _
            " ORDER BY pzrq,pzzl,pzbh,jlhm"
 End If
'    On Error Resume Next
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        
        If .EOF = False Then
            
            Call InitVariant
            .MoveFirst
            PreKjqj = .Fields("kjqj").value
            CurKjqj = .Fields("kjqj").value
            dbnYESL = 0
            dbnYEWB = 0
            dbnYE = 0
            If PreKjqj > 0 Then
                PopVar dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB
                AddYearBeginRow dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB, CurRow, lCount
            End If
            Do Until .EOF
                '如果是第一条凭证记录, 则将变量PreKjqj,CurKjqj赋值
                CurKjqj = .Fields("kjqj").value
                '与前一张凭证不在同一个月
                If CurKjqj <> PreKjqj And lCount > 0 Then
                    If PreKjqj = 0 Then
                        PopVar dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB
                        AddYearBeginRow dbnYE, dbnYESL, dbnYEWB, bnljJ, bnljJSL, bnljJWB, bnljD, bnljDSL, bnljDWB, CurRow, lCount
                        CurRow = CurRow + 1
                        lCount = lCount + 1
                    Else
                        '添加本月合计、本年累计行
                        Call AppendTotalRows(PreKjqj)
                        If (lCount Mod ROWS_PAGE) = 0 And Not rstTemp.EOF Then
                            Call AppendChangePageRow(0)
                        End If
                    End If
                Else
                    '添加当前凭证记录行
                    CurRow = CurRow + 1
                    lCount = lCount + 1
                End If
                If (lCount Mod ROWS_PAGE) = 0 Then Call AppendChangePageRow(1)
                
                '合计本月、过次
                If .Fields("FX").value = "借" Then
                    dbnYESL = dbnYESL + .Fields("sl").value
                    dbnYEWB = dbnYEWB + .Fields("wb").value
                    dbnYE = dbnYE + .Fields("je").value
                    
                    bnljJSL = bnljJSL + .Fields("sl").value
                    bnljJWB = bnljJWB + .Fields("wb").value
                    bnljJ = bnljJ + .Fields("je").value
                    
                    gcJSL = gcJSL + .Fields("sl").value
                    gcJWB = gcJWB + .Fields("wb").value
                    gcJ = gcJ + .Fields("je").value
                    
                    byhjJSL = byhjJSL + .Fields("sl").value
                    byhjJWB = byhjJWB + .Fields("wb").value
                    byhjJ = byhjJ + .Fields("je").value
                Else
                    dbnYESL = dbnYESL - .Fields("sl").value
                    dbnYEWB = dbnYEWB - .Fields("wb").value
                    dbnYE = dbnYE - .Fields("je").value
                    bnljDSL = bnljDSL + .Fields("sl").value
                    bnljDWB = bnljDWB + .Fields("wb").value
                    bnljD = bnljD + .Fields("je").value
                    
                    gcDSL = gcDSL + .Fields("sl").value
                    gcDWB = gcDWB + .Fields("wb").value
                    gcD = gcD + .Fields("je").value
                    
                    byhjDSL = b