frmac_generalresult.frm

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

            .MergeCells COL_START, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        End If
        .MergeCells COL_START, ROW_SUBJNAME, COL_BALANCE_MONEY - 1, ROW_SUBJNAME
        .SetCellAlign COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 35
        .s COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, "总    页 第  " + CStr(.GetCurSheet + 1) + " 页"
        .SetCellFont COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 10
        .SetCellFontStyle COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 0
        
        .SetCellFont COL_START, ROW_SUBJCODE, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_SUBJCODE, .GetCurSheet, 10
        .SetCellFontStyle COL_START, ROW_SUBJCODE, .GetCurSheet, 0
        
        .SetCellFont COL_START, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_SUBJNAME, .GetCurSheet, 10
        .SetCellFontStyle COL_START, ROW_SUBJNAME, .GetCurSheet, 0
        Cllr.SetCellString COL_START, ROW_SUBJCODE, .GetCurSheet, "科目代码：" & m_sPrintSubjectCode
        Cllr.SetCellString COL_START, ROW_SUBJNAME, .GetCurSheet, "科目名称：" & m_sPrintSubjectName
 

        If m_bAmount Then
            If m_bForeign Then
                .SetCellString COL_BALANCE_MONEY, ROW_SUBJCODE, .GetCurSheet, "数量单位：" & m_sSldw
                .SetCellString COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, "外币币名：" & m_sWbdw
            Else
                .SetCellString COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, "数量单位：" & m_sSldw
            End If
        ElseIf m_bForeign Then
            .SetCellString COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, "外币币名：" & m_sWbdw
        End If
        
    'Head
        '设置页头的单元格风格
        For i = ROW_HEAD1 To ROW_HEAD2
            For j = COL_START To COL_END
               .SetCellAlign j, i, .GetCurSheet, 36
                .SetCellTextStyle j, i, .GetCurSheet, 2
            .SetCellFont j, i, .GetCurSheet, .FindFontIndex("仿宋_GB2312", 1)
            .SetCellFontSize j, i, .GetCurSheet, 10
            .SetCellFontStyle j, i, .GetCurSheet, 2
            Next j
        Next i
        
        '设置列宽
        For i = LBound(m_iColWidth) To UBound(m_iColWidth)
            .SetColWidth 1, m_iColWidth(i), i, .GetCurSheet
        Next i
        .SetColWidth 1, 3, COL_END + 1, .GetCurSheet
        
        '合并单元格
        .MergeCells COL_MONTH, ROW_HEAD1, COL_DAY, ROW_HEAD1
        .MergeCells COL_SUMMARY, ROW_HEAD1, COL_SUMMARY, ROW_HEAD2
        .MergeCells COL_DEBIT_MONEY, ROW_HEAD1, COL_DEBIT_MONEY, ROW_HEAD2
        .MergeCells COL_CREDIT_MONEY, ROW_HEAD1, COL_CREDIT_MONEY, ROW_HEAD2
        .MergeCells COL_DIRECTION, ROW_HEAD1, COL_DIRECTION, ROW_HEAD2
        .MergeCells COL_BALANCE_MONEY, ROW_HEAD1, COL_BALANCE_MONEY, ROW_HEAD2
        
        '设置内容
        .SetCellString COL_MONTH, ROW_HEAD1, .GetCurSheet, m_iYear & "年"
        .SetCellString COL_MONTH, ROW_HEAD2, .GetCurSheet, "月"
        .SetCellString COL_DAY, ROW_HEAD2, .GetCurSheet, "日"
        .SetCellString COL_SUMMARY, ROW_HEAD1, .GetCurSheet, "摘        要"
        .SetCellString COL_DEBIT_MONEY, ROW_HEAD1, .GetCurSheet, "借方"
        .SetCellString COL_DEBIT_AMOUNT, ROW_HEAD2, .GetCurSheet, "数量"
        .SetCellString COL_DEBIT_FOREIGN, ROW_HEAD2, .GetCurSheet, "外币"
        .SetCellString COL_DEBIT_MONEY, ROW_HEAD2, .GetCurSheet, "金额"
        .SetCellString COL_CREDIT_MONEY, ROW_HEAD1, .GetCurSheet, "贷方"
        .SetCellString COL_CREDIT_AMOUNT, ROW_HEAD2, .GetCurSheet, "数量"
        .SetCellString COL_CREDIT_FOREIGN, ROW_HEAD2, .GetCurSheet, "外币"
        .SetCellString COL_CREDIT_MONEY, ROW_HEAD2, .GetCurSheet, "金额"
        .SetCellString COL_DIRECTION, ROW_HEAD1, .GetCurSheet, "方向"
        .SetCellString COL_BALANCE_MONEY, ROW_HEAD1, .GetCurSheet, "余额"
        .SetCellString COL_BALANCE_AMOUNT, ROW_HEAD2, .GetCurSheet, "数量"
        .SetCellString COL_BALANCE_FOREIGN, ROW_HEAD2, .GetCurSheet, "外币"
        .SetCellString COL_BALANCE_MONEY, ROW_HEAD2, .GetCurSheet, "金额"
    
        
    'Draw Line
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_MONTH, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_DAY, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        
        .SetRows .GetRows(.GetCurSheet) + 1, .GetCurSheet
        i = .GetRows(.GetCurSheet) - 1
        '合并到单元格"借方外币"是由于当借方外币列宽为零时,打印预览会不显示打印日期;
        .MergeCells COL_START, i, COL_DEBIT_FOREIGN, i
        .MergeCells COL_DEBIT_MONEY, i, COL_END, i
        .SetCellAlign COL_START, i, .GetCurSheet, 33
        .SetCellAlign COL_DEBIT_MONEY, i, .GetCurSheet, 34
        .SetCellFont COL_START, i, .GetCurSheet, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_START, i, .GetCurSheet, 9
        .SetCellFontStyle COL_START, i, .GetCurSheet, 0

        .SetCellFont COL_DEBIT_MONEY, i, .GetCurSheet, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_DEBIT_MONEY, i, .GetCurSheet, 9
        .SetCellFontStyle COL_DEBIT_MONEY, i, .GetCurSheet, 0
        .SetCellString COL_START, i, .GetCurSheet, "核算单位：" & m_sEnterName
        .SetCellString COL_DEBIT_MONEY, i, .GetCurSheet, "( 打印日期：" & Format(Date, "yyyy-mm-dd") & _
                    "    时间：" & Format(Time, "hh:MM:ss") & " )"
        .ShowPageBreak False
    End With
    
End Sub

'显示查总账结果
Public Sub ShowResult()
    Dim rstTemp As ADODB.Recordset
    Dim maxKjqj As Integer                      '当前已记账凭证的最大会计期间
    Dim StartDate As Date                       '查询开始日期
    Dim sSQL As String
    Dim dDebit_Amount As Double, dDebit_Foreign As Double, dDebit_Money As Double
    Dim dCredit_Amount As Double, dCredit_Foreign As Double, dCredit_Money As Double
    Dim sDireciton As String
    Dim sHappenDirection As String
    Dim dBalance_Amount As Double, dBalance_Foreign As Double, dBalance_Money As Double
    Dim i As Long, j As Long, k As Long
    
    fMainForm.MousePointer = vbHourglass
    
    '设置科目代码名称
    m_sSubjCode = arySubDetail(cboSubject.ListIndex + 1).sSubjectCode
    m_sSubjName = arySubDetail(cboSubject.ListIndex + 1).sSubjectName
      
   '得到打印时显示的科目代码和名称以及总账科目
     If glo.sSeparateSubject = "0" Then
        If glo.bSeparateSubject Then
            m_sPrintSubjectCode = SeparateSubject(glo.sAccountID, m_sSubjCode)
        Else
            m_sPrintSubjectCode = m_sSubjCode
        End If
    Else
         m_sPrintSubjectCode = m_sSubjCode
    End If
    
    m_sPrintSubjectName = GetSubjectFullPath(glo.sAccountID, m_sSubjCode)
    If InStr(1, m_sPrintSubjectName, "\") > 0 Then
        m_sGenSubjectName = Mid(m_sPrintSubjectName, 1, InStr(1, m_sPrintSubjectName, "\") - 1)
    Else
        m_sGenSubjectName = m_sPrintSubjectName
    End If
    
    '得到当前账套的单位名称
    m_sEnterName = GetDWMC
    If m_sEnterName = "" Then
        Exit Sub
    End If
    
    '得到一个科目数量单位和外币单位
    Call GetSldwAndWbdw(m_sSubjCode, 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
    
    
    '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
    Cllr.Visible = False

    Cllr.ResetContent
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    m_iYear = glo.sOperateYear
    sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    With rstTemp
        .Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            '如果注册年份大于账务子系统启用年份, 查询开始月份等于1;
            '否则如果注册年份等于账务子系统启用年份, 查询开始月份等于账务子系统启用月份;
            '否则报错;
            If glo.sOperateYear > .Fields("BeginYear").value Then
                m_iFromMonth = 1
            ElseIf glo.sOperateYear = .Fields("BeginYear").value Then
                m_iFromMonth = .Fields("BeginMonth").value
            Else
                MsgBox "注册年份不能小于账务子系统启用年份", vbCritical
                Unload Me
                Exit Sub
            End If
            '如果注册年份大于账务子系统结账年份, 则求查询截止月份(0);
            '否则如果注册年份等于账务子系统结账年份, 则求查询截止月份(结账月份);
            '否则查询截止月份等于12月份;
            If glo.sOperateYear > .Fields("ModiYear").value Then
                m_iToMonth = GetToMonth(0)
            ElseIf glo.sOperateYear = .Fields("ModiYear").value Then
                m_iToMonth = GetToMonth(.Fields("ModiMonth").value)
            Else
                m_iToMonth = 12
            End If
        End If
        .Close
    End With
    
    '从科目表中取出科目名称、年(期)初累计数、年(期)初月到十二月的累计数
    sSQL = "SELECT ljjsl00,ljjwb00,ljj00,ljdsl00,ljdwb00,ljd00"
    For i = m_iFromMonth - 1 To 12
        sSQL = sSQL & ",ljjsl" & Format(i, "00") & ",ljjwb" & Format(i, "00") & ",ljj" & Format(i, "00") & _
                      ",ljdsl" & Format(i, "00") & ",ljdwb" & Format(i, "00") & ",ljd" & Format(i, "00")
    Next i
    sSQL = sSQL & " FROM tZW_balance" & glo.sOperateYear & " WHERE kmdm = '" & m_sSubjCode & "'"
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            '求表格总行数
            Cllr.SetRows ROW_GRID_START + 1 + 2 * (IIf(m_iToMonth = 0, 0, m_iToMonth - m_iFromMonth + 1)), Cllr.GetCurSheet
            Cllr.SetCols COL_END + 2, Cllr.GetCurSheet                              '表格列数
            '设置单元格的显示风格
            For i = ROW_GRID_START To Cllr.GetRows(Cllr.GetCurSheet) - 1
                For j = COL_START To COL_END
                Cllr.SetCellFont j, i, Cllr.GetCurSheet, Cllr.FindFontIndex("宋体", 1)
                Cllr.SetCellFontSize j, i, Cllr.GetCurSheet, 9
                Cllr.SetCellFontStyle j, i, Cllr.GetCurSheet, 0
                Next j
                Cllr.SetCellAlign COL_MONTH, i, Cllr.GetCurSheet, 32 + 4
                Cllr.SetCellAlign COL_DAY, i, Cllr.GetCurSheet, 32 + 4
                Cllr.SetCellAlign COL_SUMMARY, i, Cllr.GetCurSheet, 32 + 4
                
                Cllr.SetCellNumType COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, 3
                
                Cllr.SetCellNumType COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, 2
                
                Cllr.SetCellNumType COL_DEBIT_MONEY, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_DEBIT_MONEY, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_DEBIT_MONEY, i, Cllr.GetCurSheet, 2
                
                Cllr.SetCellNumType COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, 3
                
                Cllr.SetCellNumType COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, 2
                
                Cllr.SetCellNumType COL_CREDIT_MONEY, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_CREDIT_MONEY, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_CREDIT_MONEY, i, Cllr.GetCurSheet, 2
                
                Cllr.SetCellAlign COL_DIRECTION, i, Cllr.GetCurSheet, 32 + 4
                
                Cllr.SetCellNumType COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, 3
                
                Cllr.SetCellNumType COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, 2
                
                
                Cllr.SetCellNumType COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 1
                Cllr.SetCellSeparator COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 2
                Cllr.SetCellDigital COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 2
            Next i
            
            '求年初余额(期初余额)
            dBalance_Amount = .Fields("ljjsl" & Format(m_iFromMonth - 1, "00")).value - _
                                .Fields("ljdsl" & Format(m_iFromMonth - 1, "00")).value
            dBalance_Foreign = .Fields("ljjwb" & Format(m_iFromMonth - 1, "00")).value - _
                                .Fields("ljdwb" & Format(m_iFromMonth - 1, "00")).value
            dBalance_Money = .Fields("ljj" & Format(m_iFromMonth - 1, "00")).value - _
                                .Fields("ljd" & Format(m_iFromMonth - 1, "00")).value
            If dBalance_Money > 0 Then
                sDireciton = "借"
            ElseIf dBalance_Money = 0 Then
                sDireciton = "平"
            Else
                sDireciton = "贷"
                '此时dBlance_Money小于零;
                '如果dBalance_Amount(或者dBalance_Foreign)等于 -dBalance_Amount(或者 - dBalance_Foreign)
                dBalance_Amount = -dBalance_Amount
                dBalance_Foreign = -dBalance_Foreign
            End If
            i = ROW_GRID_START
            
            StartDate = CDate(GetPeriodFrom(m_iFromMonth))
            Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, Month(StartDate)
            Cllr.SetCellString COL_DAY, i, Cllr.GetCurSheet, Day(StartDate)
            Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, IIf(m_iFromMonth = 1, "[ 上  年  结  转 ]", "[ 期  初  余  额 ]")
            Cllr.SetCellString COL_DIRECTION, i, Cllr.GetCurSheet, sDireciton
        If dBalance_Amount <> 0 Then
            Cllr.SetCellDouble COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, dBalance_Amount
        End If
        If dBalance_Foreign <> 0 Then
            Cllr.SetCellDouble COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, dBalance_Foreign
        End If
        If Abs(dBalance_Money) <> 0 Then
            Cllr.SetCellDouble COL_BALANCE_MONEY, i, Cllr.GetCurSheet, Abs(dBalance_Money)