frmlastyearcarryforward.frm

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

        sCarryForwardTableName(1) = "科目余额"
        sCarryForwardTableName(2) = "未两清单位银行账"
        sCarryForwardTableName(3) = "未两清银行对账单"
        
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 dDwtzqwb 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 24)

    Set adoRst = New ADODB.Recordset
    adoRst.CursorLocation = adUseClient
   
'================================2002.8.22 yao add=====================================
    Dim iID As Integer                              '插入凭证流水号
    Dim sFieldName As String                        '凭证字段名列表
    iID = 0
'=====================================================================================
    
    On Error GoTo HandleErr
    Select Case sTableName
            
        Case "科目余额"
        
            glo.frmProg.SetMsg "正在准备科目余额数据, 请稍候..."
             
            '从结转年份的科目表中查找是否存在记录,
            '如果存在, 则可结转上年科目余额;
            '否则, 不结转
            '结转科目代码
            adoSQL = "SELECT COUNT(*) FROM tZW_balance" & sCarryForwardYear - 1
            With adoRst
                .Open adoSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
                If .Fields(0).Value > 0 Then
                    bExistKm = True
                End If
                .Close
            End With
            
            If bExistKm Then
                bFound = False
                adoSQL = ""
                For i = 0 To 12
                    adoSQL = adoSQL + ",ljj" + Format(i, "00") + "=0,ljjsl" + Format(i, "00") + "=0,ljjwb" + Format(i, "00") + "=0,ljd" + Format(i, "00") + "=0,ljdsl" + Format(i, "00") + "=0,ljdwb" + Format(i, "00") + "=0"
                Next
                adoSQL = Mid$(adoSQL, 2)
                glo.cnnMain.Execute "Update tZW_Balance" + sCarryForwardYear + " set " + adoSQL
                '从上年科目表中取出有余额的一级科目代码
                adoSQL = "SELECT A.kmdm kmdm ,B.kmjc kmjc  FROM tZW_balance" & sCarryForwardYear - 1 & " A ,tzw_km" & sCarryForwardYear & _
                        " B WHERE A.ljj12 <> A.ljd12 AND B.kmjc = 1 and A.kmdm=B.kmdm"
                With adoRst
                    .Open adoSQL, glo.cnnMain, 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, glo.cnnMain, 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)
                                    '如果该科目的一级科目存在余额,则结转该科目的上年余额
                                    If Trim(.Fields("kmdm").Value) Like sKmdm(i) & "*" Then
                                        If .Fields("yefx").Value = "借方" Then
                                            dBalanceAmount = .Fields("ljjsl12").Value - .Fields("ljdsl12").Value
                                            dBalanceForeign = .Fields("ljjwb12").Value - .Fields("ljdwb12").Value
                                            dBalanceMoney = .Fields("ljj12").Value - .Fields("ljd12").Value
                                            
                                            For m = 0 To 12
                                                sMonth = Format(m, "00")
                                                sSQL = sSQL & "ljjsl" & sMonth & " =  " & dBalanceAmount & _
                                                       ", ljjwb" & sMonth & " = " & dBalanceForeign & _
                                                       ", ljj" & sMonth & " = " & dBalanceMoney & ","
                                            Next m
                                            sSQL = Left(sSQL, Len(sSQL) - 1)
                                            sCmdText = "UPDATE tZW_balance" & sCarryForwardYear & "  set " & sSQL
                                            '如果该科目是末级科目, 则该科目为不可增加下级科目;
                                            adoCmd.CommandText = sCmdText & " WHERE kmdm = '" & _
                                                                .Fields("kmdm").Value & "'"
                                                
                                        Else
                                            dBalanceAmount = .Fields("ljdsl12").Value - .Fields("ljjsl12").Value
                                            dBalanceForeign = .Fields("ljdsl12").Value - .Fields("ljjsl12").Value
                                            dBalanceMoney = .Fields("ljd12").Value - .Fields("ljj12").Value
     
                                            For m = 0 To 12
                                                 sMonth = Format(m, "00")
                                                 sSQL = sSQL & "  ljdsl" & sMonth & " =" & dBalanceAmount & _
                                                               ", ljdwb" & sMonth & " =  " & dBalanceForeign & _
                                                               ", ljd" & sMonth & " =  " & dBalanceMoney & ","
                                            Next m
                                            sSQL = Left(sSQL, Len(sSQL) - 1)
                                            sCmdText = "UPDATE tZW_balance" & sCarryForwardYear & "  set " & sSQL
                                                                    
                                            adoCmd.CommandText = sCmdText & " WHERE kmdm = '" & _
                                                                .Fields("kmdm").Value & "'"
                                        End If
                                        adoCmd.Execute
                             
                                        Exit For
                                    End If
                                Next i
                                .MoveNext
                            Loop
                        End If
                        .Close
                    End With
                End If
            Else
                MsgBox "未发现任何科目！", vbInformation, ""
            End If
        
        Case "未两清单位银行账"
        
            glo.frmProg.SetMsg "正在准备未两清单位银行账, 请稍候..."
            
            IsExistCarryForwardData = False
            adoSQL = "SELECT COUNT(*) FROM tZW_Km" & sCarryForwardYear - 1 & _
                        " WHERE IsYhz = -1 AND IsEndKm = -1"
            With adoRst
                .Open adoSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
                If .Fields(0).Value = 0 Then
                    MsgBox "未设置银行账科目, 不能结转未两清单位银行账!", vbInformation
                    .Close
                    Exit Sub
                End If
                .Close
            End With
            
            adoSQL = "SELECT A.kmdm,qyrq FROM tZW_Yhdzqyrq A,tZW_Km" & sCarryForwardYear - 1 & " B" & _
                        " WHERE rtrim(A.kmdm) = rtrim(B.kmdm) AND B.IsYhz = -1 AND B.IsEndKm = -1 " & _
                        " ORDER BY A.kmdm"
            With adoRst
                .Open adoSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
                If .RecordCount = 0 Then
                    MsgBox "银行对账尚未启用, 不能结转未两清单位银行账!", vbInformation
                    .Close
                    Exit Sub
                Else
                    ReDim sKmdm(1 To .RecordCount)
                    ReDim sYhdzqyrq(.RecordCount)
                    .MoveFirst
                    i = 0
                    Do Until .EOF
                        i = i + 1
                        sKmdm(i) = Trim(.Fields("kmdm").Value)
                        If Year(.Fields("qyrq").Value) = CInt(sCarryForwardYear) - 1 Then
                            sYhdzqyrq(i) = Format(.Fields("qyrq").Value, "yyyy-mm-dd")
                        Else
                            sYhdzqyrq(i) = sCarryForwardYear - 1 & "-01-01"
                        End If
                        .MoveNext
                    Loop
                    For i = LBound(sKmdm) To UBound(sKmdm)
                        If i = LBound(sKmdm) Then
                            sYhKmdm = sKmdm(i)
                        Else
                            sYhKmdm = sYhKmdm & "," & sKmdm(i)
                        End If
                    Next i
                End If
                .Close
            End With
            
            
            adoCmd.CommandText = "DELETE FROM tZW_Pzsj" & sCarryForwardYear & _
                                    " WHERE kjqj = 20 OR kjqj = 21"
            adoCmd.Execute
            
            iMaxJlhm = 0
            '依次结转各个科目的调整前余额、未两清银行账
            For iKmNum = LBound(sKmdm) To UBound(sKmdm)
                
                Select Case g_FLAT
                    Case "SQL"
                        adoSQL = "SELECT * FROM tZW_Pzsj" & sCarryForwardYear - 1 & _
                                    " WHERE kmdm = '" & sKmdm(iKmNum) & _
                                    "' AND (kjqj = 21 OR (kjqj < 20 AND" & _
                                    " pzrq >= '" & sYhdzqyrq(iKmNum) & "'))" & _
                                    " AND yhdz_lqbz Is Null AND xgbz = '2' " + IIf(GetKmWbdw(sKmdm(iKmNum)) <> "", "and wb<>0", "")
                    Case "ORACLE"
                        adoSQL = "SELECT * FROM tZW_Pzsj" & sCarryForwardYear - 1 & _
                                    " WHERE kmdm = '" & sKmdm(iKmNum) & _
                                    "' AND (kjqj = 21 OR (kjqj < 20 AND" & _
                                    " pzrq >= TO_DATE('" & sYhdzqyrq(iKmNum) & _
                                    "','YYYY-MM-DD')))" & _