frmac_generalselectprint.frm

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

            .MergeCells COL_BALANCE_MONEY, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
            .SetCellFont COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
            .SetCellFontSize COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 11
            .SetCellFontStyle COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 0
            .SetCellAlign COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 33
        Else
            .MergeCells COL_START, ROW_SUBJCODE, COL_END, ROW_SUBJCODE
            .MergeCells COL_START, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        End If
            .SetCellFont COL_START, ROW_SUBJCODE, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
            .SetCellFontSize COL_START, ROW_SUBJCODE, .GetCurSheet, 11
            .SetCellFontStyle COL_START, ROW_SUBJCODE, .GetCurSheet, 0
            
            .SetCellFont COL_START, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
            .SetCellFontSize COL_START, ROW_SUBJNAME, .GetCurSheet, 11
            .SetCellFontStyle COL_START, ROW_SUBJNAME, .GetCurSheet, 0
        .SetCellString COL_START, ROW_SUBJCODE, .GetCurSheet, "科目代码：" & m_sSubjCode
        .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, 11
            .SetCellFontStyle j, i, .GetCurSheet, 2
            Next j
            .SetRowHeight 1, 25.9, i, .GetCurSheet
        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, glo.sOperateYear & "年"
        .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, "金额"
        .ShowPageBreak False
    End With
      

End Sub
'显示查总账结果
Public Function ShowResult(Optional ByVal iPageStart As Integer = 0) As Integer
    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 dBalance_Amount As Double, dBalance_Foreign As Double, dBalance_Money As Double
    Dim i As Long, j As Long, k As Long
    '先认为没有发生
    ubHappen = False
    
    Screen.MousePointer = vbHourglass
    '得到当前账套的单位名称
    m_sEnterName = GetDWMC
    If m_sEnterName = "" Then
        Exit Function
    End If
    
     '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；

    Cllr.ResetContent
    '得到打印时显示的科目代码和名称以及总账科目
    
    If glo.bSeparateSubject Then
        m_sPrintSubjectCode = SeparateSubject(glo.sAccountID, m_sSubjCode)
    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
      
    '得到一个科目数量单位和外币单位
    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
    Call SetGridHead
    
    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 Function
            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
            MsgBox "此账户不存在！", vbInformation
            m_bExistRecord = False
            .Close
            fMainForm.MousePointer = vbDefault
            Unload Me
        Else
            '求表格总行数
            Cllr.SetRows ROW_GRID_START + 1 + 2 * (IIf(m_iToMonth = 0, 0, m_iToMonth - m_iFromMonth + 1)), 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, 11
                    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.SetCellAlign COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, 32 + 2
                
                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.SetCellAlign COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, 32 + 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.SetCellAlign COL_DEBIT_MONEY, i, Cllr.GetCurSheet, 32 + 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.SetCellAlign COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, 32 + 2
                
                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.SetCellAlign COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, 32 + 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_CREDIT_MONEY, i, Cllr.GetCurSheet, 32 + 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.SetCellAlign COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, 32 + 2
                
                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.SetCellAlign COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, 32 + 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
                Cllr.SetCellAlign COL_BALANCE_MONEY, i, Cllr.GetCurSheet, 32 + 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)
         End If
            
            '从年(期)初月份到十二月份,求出当前输入科目的累计余额；
            For k = m_iFromMonth To m_iToMonth
                '求本期合计
                i = i + 1
                dDebit_Amount = .Fields("ljjsl" & Format(k, "00")).value - _
                                .Fields("ljjsl" & Format(k - 1, "00")).value
                dDebit_Foreign = .Fields("ljjwb" & Format(k, "00")).value - _
                                 .Fields("ljjwb" & Format(k - 1, "00")).value
                dDebit_Money = .Fields("ljj" & Format(k, "00")).value - _
                               .Fields("ljj" & Format(k - 1, "00")).value
                               
                dCredit_Amount = .Fields("ljdsl" & Format(k, "00")).value - _
                                 .Fields("ljdsl" & Format(k - 1, "00")).value
                dCredit_Foreign = .Fields("ljdwb" & Format(k, "00")).value - _
                                  .Fields("ljdwb" & Format(k - 1, "00")).value
                dCredit_Money = .Fields("ljd" & Format(k, "00")).value - _
                                .Fields("ljd" & Format(k - 1, "00")).value
                                
                dBalance_Amount = dDebit_Amount - dCredit_Amount
                dBalance_Foreign = dDebit_Foreign - dCredit_Foreign
                dBalance_Money = dDebit_Money - dCredit_Money
                If dBalance_Money > 0 Then
                    sDireciton = "借"
                ElseIf dBalance_Money = 0 Then
                    sDireciton = "平"
                Else
                    sDireciton = "贷"
                    dBalance_Amount = -dBalance_Amount
                    dBalance_Foreign = -dBalance_Foreign
                End If
                Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, k
                Cllr.SetCellString COL_DAY, i, Cllr.GetCurSheet, Day(GetPeriodTo(k))
                Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, "[ 本  月  合  计 ]"
            If Abs(dDebit_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, dDebit_Amount
            End If
            If Abs(dDebit_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, dDebit_Foreign
            End If
            If Abs(dDebit_Money) > 0.0001 Then
                ubHappen = True
                Cllr.SetCellDouble COL_DEBIT_MONEY, i, Cllr.GetCurSheet, dDebit_Money
            End If
            If Abs(dCredit_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, dCredit_Amount
            End If
            If Abs(dCredit_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, dCredit_Foreign
            End If
            If Abs(dCredit_Money) > 0.0001 Then