frmlastyearcarryforward.frm

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

        If .RecordCount > 0 Then
            .MoveFirst
            Do Until .EOF
                Select Case .Fields("SubSysID").Value
                    Case "ZW"
                        bSubSysUsed.ZW = True
                        sBeginYear = .Fields("BeginYear").Value
                        sModiYear = .Fields("ModiYear").Value
                        sModiMonth = .Fields("ModiMonth").Value
    
                    Case "BB"
                        bSubSysUsed.BB = True
                    Case "GD"
                        bSubSysUsed.GD = True
                    Case "GZ"
                        bSubSysUsed.GZ = True
                    Case "FX"
                        bSubSysUsed.FX = True
                    Case "RS"
                        bSubSysUsed.RS = True
                    Case "CF"
                        bSubSysUsed.CF = True
                    Case "MR"
                        bSubSysUsed.MR = True
                End Select
                .MoveNext
            Loop
        End If
        .Close
    End With
    
    lblAccountName.Caption = usAccountName
    lblNewYear.Caption = sCarryForwardYear
    
    Set adoCnnAccount = New ADODB.Connection
    
    Select Case g_FLAT
        Case "SQL"
            adoCnnAccount.Open GetConnectString(g_FLAT, gloSys.sServer, _
                gloSys.sUser, s.decrypt(gloSys.sPassword), "cwDB" & usAccountID)
        Case "ORACLE"
            adoCnnAccount.CommandTimeout = 300
            adoCnnAccount.CursorLocation = adUseClient
            adoCnnAccount.Open GetConnectString(g_FLAT, gloSys.sServer, _
                "cwDB" & usAccountID, "ykcwDB" & usAccountID)
    End Select
    
    Set adoCmd = New ADODB.Command
    adoCmd.CommandType = adCmdText
    adoCmd.ActiveConnection = adoCnnAccount
    
End Sub

Private Sub GetCarryForwardTable()
    
    If bSubSysUsed.ZW Then
        ReDim sCarryForwardTableCode(1 To 7)
        ReDim sCarryForwardTableName(1 To 7)
        
        sCarryForwardTableCode(1) = "tZW_Km"
        sCarryForwardTableCode(2) = "tZW_Balance"
        sCarryForwardTableCode(3) = "tUSU_Fz"
        sCarryForwardTableCode(4) = "tZW_Exch"
        sCarryForwardTableCode(5) = "tZW_Pzsj"
        sCarryForwardTableCode(6) = "tZW_Yhdzd"
        sCarryForwardTableCode(7) = "tZW_ZzpzSet"
        
        sCarryForwardTableName(1) = "会计科目"
        sCarryForwardTableName(2) = "科目余额"
        sCarryForwardTableName(3) = "辅助核算科目余额"
        sCarryForwardTableName(4) = "汇率数据"
        sCarryForwardTableName(5) = "未两清单位银行账"
        sCarryForwardTableName(6) = "未两清银行对账单"
        sCarryForwardTableName(7) = "转账凭证设置"
    End If
    If bSubSysUsed.BB Then
    
    End If
    If bSubSysUsed.GD Then
    
    End If
    If bSubSysUsed.GZ Then
    
    End If
    If bSubSysUsed.CF Then
        ReDim Preserve sCarryForwardTableCode(1 To UBound(sCarryForwardTableCode) + 1)
        ReDim Preserve sCarryForwardTableName(1 To UBound(sCarryForwardTableName) + 1)
            sCarryForwardTableCode(UBound(sCarryForwardTableCode)) = "tCF_Item"
            sCarryForwardTableName(UBound(sCarryForwardTableName)) = "现金流量项目"
            
        ReDim Preserve sCarryForwardTableCode(1 To UBound(sCarryForwardTableCode) + 1)
        ReDim Preserve sCarryForwardTableName(1 To UBound(sCarryForwardTableName) + 1)
            sCarryForwardTableCode(UBound(sCarryForwardTableCode)) = "tCF_Source"
            sCarryForwardTableName(UBound(sCarryForwardTableName)) = "项目数据来源"
    End If
    If bSubSysUsed.FX Then
    
    End If
    If bSubSysUsed.RS Then
    
    End If
    If bSubSysUsed.MR Then
       
    End If
End Sub

Private Sub CarryForwardData(ByVal sTableCode As String, ByVal sTableName As String)

    Dim sSingleRecord() As String                   '存放一张表中的字段值
    Dim vTotalRecord() As Variant                   '存放一张表中的记录
    Dim sKmdm() As String                           '存放有余额的一级科目代码
    Dim sYhdzqyrq() As String                       '存放各个银行对账科目的银行对账的启用日期
    Dim sYhKmdm As String                           '存放为银行账的科目
    Dim dBalanceAmount As Double                    '结转科目的数量余额
    Dim dBalanceForeign As Double                   '结转科目的外币余额
    Dim dBalanceMoney As Double                     '结转科目的金额余额
    
    Dim dDwtzqye As Double                          '银行对账科目的单位方调整前余额
    Dim dYhtzqye As Double                          '银行对账科目的银行方调整前余额
    
    Dim bExistKm As Boolean                         '结转年份是否存在科目
    Dim bFound As Boolean                           '上年科目是否存在有余额的科目
    Dim sCmdText As String                          'SQL语句命令文本
    Dim insertStr As String                         'SQL语句插入的命令字符串
    Dim iKmNum As Integer                           '需结转科目的数量
    Dim iMaxJlhm As Integer                         '结转年份凭证表中未两清凭证记录的最大记录号
    Dim iMaxId As Integer                           '结转年份银行对账单中未两清对账单记录的最大记录号
    Dim IsExistCarryForwardData As Boolean          '是否存在结转数据
    
    Dim iTotalNum As Integer
    Dim pgrNum As Double                            '进度条每进一格所需的记录数
    Dim CurNum As Integer                           '当前的记录数
    Dim CurPgrNum As Integer                        '当前进度条已完成的百分数
    
    Dim sSql As String
    Dim sMonth As String
    Dim i As Integer

    Dim IsBig As Boolean
    
    Dim j As Integer
    
    ReDim sHaveTableName(1 To 7)

    Set adoRst = New ADODB.Recordset
    adoRst.CursorLocation = adUseClient
    
    Select Case sTableName
        Case "会计科目"
            
            glo.frmProg.SetMsg "正在准备结转会计科目数据, 请稍候..."
            
            '删除结转年份的会计科目表
            adoCmd.CommandText = "DELETE FROM tZW_Km" & sCarryForwardYear
            adoCmd.Execute
            
            '从结转年份上一年中取出记录
            adoSQL = "SELECT kmdm,kmmc,kmmcEng,zjm,kmlx,kmjc,IsEndKm,yefx,zygs,hzdykm," & _
                    "sldw,wbdw,IsRjz,IsYhz,IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs," & _
                    "IsXjllkm,Xjlllb,Jfkze,Dfkze,Yekze,kmqx,Cwfxlx,IsFc,bUse,Clawless" & _
                    " FROM tZW_Km" & sCarryForwardYear - 1
               
                   glo.frmProg.SetMsg "正在结转会计科目数据....................."
                   adoSQL = "INSERT INTO tZW_Km" & sCarryForwardYear & _
                                    "(kmdm,kmmc,kmmcEng,zjm,kmlx,kmjc,IsEndKm,yefx,zygs,hzdykm," & _
                                    "sldw,wbdw,IsRjz,IsYhz,IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs," & _
                                    "IsXjllkm,Xjlllb,Jfkze,Dfkze,Yekze,kmqx,Cwfxlx,IsFc,bUse,Clawless)" & adoSQL
                  adoCmd.CommandText = adoSQL
                  adoCmd.Execute
            
        Case "科目余额"
        
            glo.frmProg.SetMsg "正在准备科目余额数据, 请稍候..."
             
            '从结转年份的科目表中查找是否存在记录,
            '如果存在, 则可结转上年科目余额;
            '否则, 不结转
            '结转科目代码
            adoSQL = "delete tzw_balance" & sCarryForwardYear
            adoCmd.CommandText = adoSQL
            adoCmd.Execute
            
            adoSQL = "insert into tzw_balance" & sCarryForwardYear & " ( kmdm,kmmc,bz,yefx )" & _
                     "  select  kmdm,kmmc,wbdw ,yefx from tzw_balance" & sCarryForwardYear - 1
            adoCmd.CommandText = adoSQL
            adoCmd.Execute
               
            adoSQL = "SELECT COUNT(*) FROM tZW_balance" & sCarryForwardYear - 1
            With adoRst
                .Open adoSQL, adoCnnAccount, adOpenStatic, adLockReadOnly
                If .Fields(0).Value > 0 Then
                    bExistKm = True
                End If
                .Close
            End With
            
            If bExistKm Then
                bFound = False
                '从上年科目表中取出有余额的一级科目代码
                adoSQL = "SELECT A.kmdm kmdm ,B.kmjc kmjc  FROM tZW_balance" & sCarryForwardYear - 1 & " A ,tzw_km" & sCarryForwardYear - 1 & _
                        " B WHERE A.ljj12 <> A.ljd12 AND B.kmjc = 1 and A.kmdm=B.kmdm"
                With adoRst
                    .Open adoSQL, adoCnnAccount, adOpenStatic, adLockReadOnly
                    If .RecordCount > 0 Then
                        bFound = True
                        ReDim sKmdm(1 To .RecordCount)
                        .MoveFirst
                        i = 0
                        Do Until .EOF
                            i = i + 1
                            sKmdm(i) = Trim(.Fields("kmdm").Value)
                            .MoveNext
                        Loop
                    End If
                    .Close
                End With
                
                
                '如果存在一级科目余额不为零的科目, 则进行结转科目余额
                If bFound Then
                    adoSQL = "SELECT kmdm,kmmc,yefx,ljjsl12,ljjwb12,ljj12,ljdsl12,ljdwb12,ljd12" & _
                            " FROM tZW_balance" & sCarryForwardYear - 1 & _
                            " WHERE ljj12 <> ljd12 ORDER BY kmdm"
                    With adoRst
                        .Open adoSQL, adoCnnAccount, adOpenStatic, adLockReadOnly
                        If .RecordCount > 0 Then
                            iTotalNum = .RecordCount
                            If .RecordCount > PrecentOfYe Then
                                IsBig = True
                                pgrNum = .RecordCount / PrecentOfYe
                            Else
                                IsBig = False
                                pgrNum = PrecentOfYe / .RecordCount
                            End If
                            CurNum = 0
                            CurPgrNum = glo.frmProg.pbr.Value
                            .MoveFirst
                            Do Until .EOF
                                CurNum = CurNum + 1
                                sSql = ""
                                If IsBig Then
                                    glo.frmProg.ShowProgress CurPgrNum + Int(CurNum / pgrNum)
                                Else
                                    glo.frmProg.ShowProgress CurPgrNum + Int(CurNum * pgrNum)
                                End If
                                glo.frmProg.SetMsg "正在结转科目余额数据... 第" & CurNum & "/" & iTotalNum & "笔"
                                Dim m As Integer
                                For i = LBound(sKmdm) To UBound(sKmdm)
                                    '如果该科目的一级科目存在余额,则结转该科目的上年余额