来自「VB开发的ERP系统」· 代码 · 共 1,480 行 · 第 1/5 页

            
            Je = Dhj
            Call Save_TempPz_Ass(lng_OperationNum, I, Trim(Rec_AutoTranItem.Fields("Digest")), Trim(Rec_AutoTranItem.Fields("Ccode")), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
            Rec_AutoTranItem.MoveNext
        Loop
        If Dhj = 0 Then
            '删除空凭证主从表
            Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchSubTemp Where VouchId=lng_OperationNum"
            Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchMainTemp Where VouchId=lng_OperationNum"
        End If
        
        If hjje = 0 Then              '合计金额
            '删除空凭证主从表
            Sqlstr = "Delete From Cwzz_AccVouchSubTemp Where VouchId=" & lng_OperationNum
            Cw_DataEnvi.DataConnect.Execute Sqlstr
            Sqlstr = "Delete From Cwzz_AccVouchMainTemp Where VouchId=" & lng_OperationNum
            Cw_DataEnvi.DataConnect.Execute Sqlstr
            VoidStr = VoidStr + Str(jsq) + " "
            TranCount = TranCount - 1
        End If
        
    Next jsq
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    '没有有效凭证生成，即金额、数量均为0
    If Len(VoidStr) <> 0 Then
        Tsxx = "第" & VoidStr & "张凭证没有发生额，不需要结转!"
        Call Xtxxts(Tsxx, 0, 4)
    End If
    
    If TranCount > 0 Then       '记录生成凭证的个数
        '记录此次转帐的批号,做为凭证窗体调用的参数
        
        AutoTran_PzFrm.OperationNumPz = OperationNum
        AutoTran_PzFrm.vouchsourcePz = "自动转帐"
        '调入凭证制作窗体
        AutoTran_PzFrm.Show 1
        
        
        '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
        Call Write_Date
        Call Clean
    End If
    Call Cxnrtcwg
    Exit Sub
    
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub


Public Sub Balance(TjMain As String, TjList As String, TjAss As String) '期末余额子过程
    
    Je = 0
    Sl = 0
    ItemSl = 0
    
    '[从科目总帐或辅助帐取年初余额
    If TjAss = "" Then
        Sqlstr = "select * from  Cwzz_AccSum  where " & TjMain & " and Year='" & Int_Year & "' and period='" & Xtmm & " '"                          '从科目总帐取月初余额"
    Else
        Sqlstr = "select * from Cwzz_AccSumAssi  where " & TjMain & "and " & TjAss & " and Year='" & Int_Year & "'   and period='" & Xtmm & " '"    '从辅助总帐取年初余额
    End If
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '余额赋初值
    If RecTemp.EOF = False Then
        Je = Trim(RecTemp.Fields("qcye") & "") '改为本月期初余额(bsj 2001-10-16)
        Sl = Trim(RecTemp.Fields("qcsl") & "") '改为本月期初余额(bsj 2001-10-16)
        
        If TjAss <> "" Then
            ItemSl = Trim(RecTemp.Fields("YcItemsl") & "")
        End If
    End If
    '[从科目总帐或辅助帐取年初余额
    
    
    '[从凭证明细取累计借方\贷方发生额\计算期末余额
    Sqlstr = "SELECT ccode,Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Debi_Itemsl=sum(Itemjfsl),Lender_Je=Sum(Dfje),Lender_Sl=Sum(dfsl)," & _
    "Lender_Itemsl=sum(ItemDfsl) FROM Cwzz_V_AccVouch "
    
    If TjAss = "" Then                                  '无辅助项目核算
        Sqlstr = Sqlstr + " where " & TjList & ""
    Else
        Sqlstr = Sqlstr + " Where " & TjList & " and " & TjAss & ""
    End If
    
    '若不包含未记帐凭证，再增加一个限制
    If Chk_Vouch.Value = 0 Then
        Sqlstr = Sqlstr & " and BookFlag='1' "
    End If
    
    Sqlstr = Sqlstr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' group by ccode " '(取本月数 bsj 2001-10-16)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '计算期末余额
    If RecTemp.EOF = False Then
        Do While RecTemp.EOF = False
            Je = Je + Val(RecTemp.Fields("Debi_je") & "") - Val(RecTemp.Fields("Lender_je") & "")
            Sl = Sl + Val(RecTemp.Fields("Debi_sl") & "") - Val(RecTemp.Fields("Lender_sl") & "")
            If TjAss <> "" Then
                ItemSl = ItemSl + Val(RecTemp.Fields("Debi_Itemsl") & "") - Val(RecTemp.Fields("Lender_Itemsl") & "")
            End If
            RecTemp.MoveNext
        Loop
    End If
    ']从凭证明细取累计借方\贷方发生额\计算期末余额
    
End Sub

Public Sub Debi(TjList As String, TjAss As String)       ''从凭证明细帐求本期借方发生额
    'TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
    Je = 0
    Sl = 0
    ItemSl = 0
    
    Sqlstr = "SELECT Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Debi_Itemsl=sum(Itemjfsl) " & _
    "FROM Cwzz_V_AccVouch "
    If TjAss = "" Then
        Sqlstr = Sqlstr + "where " & TjList & " "
    Else
        Sqlstr = Sqlstr + "where " & TjList & " and " & TjAss & " "
    End If
    If Chk_Vouch.Value = 0 Then         '不包含未记帐凭证
        Sqlstr = Sqlstr & " and BookFlag='1'"
    End If
    Sqlstr = Sqlstr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' Group by Ccode"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.EOF = False Then
        Do While RecTemp.EOF = False
            Je = Je + Val(RecTemp.Fields("Debi_Je") & "")
            Sl = Sl + Val(RecTemp.Fields("Debi_Sl") & "")
            ItemSl = ItemSl + Val(RecTemp.Fields("Debi_ItemSl") & "")
            RecTemp.MoveNext
        Loop
    End If
End Sub

Public Sub Lender(TjList As String, TjAss As String)        ''从凭证明细帐求本期贷方发生额
    'TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
    Je = 0
    Sl = 0
    ItemSl = 0
    
    Sqlstr = "SELECT Lender_Je=Sum(Dfje),Lender_Sl=Sum(Dfsl),Lender_ItemSl=sum(ItemDfsl) " & _
    "FROM Cwzz_V_AccVouch "
    If TjAss = "" Then
        Sqlstr = Sqlstr + "where " & TjList & " "
    Else
        Sqlstr = Sqlstr + "where " & TjList & " and " & TjAss & " "
    End If
    If Chk_Vouch.Value = 0 Then         '不包含未记帐凭证
        Sqlstr = Sqlstr & " and BookFlag='1'"
    End If
    Sqlstr = Sqlstr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' Group by Ccode"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.EOF = False Then
        Do While RecTemp.EOF = False
            Je = Je + Val(RecTemp.Fields("Lender_Je") & "")
            Sl = Sl + Val(RecTemp.Fields("Lender_Sl") & "")
            ItemSl = ItemSl + Val(RecTemp.Fields("Lender_ItemSl") & "")
            RecTemp.MoveNext
        Loop
    End If
End Sub

Public Sub Balance_Sy(TjMain As String, TjList As String, TjAss As String) '期间损益结转，以明细帐为循环体求总帐中不符合条件的科目期末余额
    'TjMain为取年初余额的条件，TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
    'Je表示期末余额，Sl表示期末余数量
    Je = 0
    Sl = 0
    ItemSl = 0
    
    '[从凭证明细取累计借方、贷方发生额等
    Sqlstr = "SELECT ccode,Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Lender_Je=Sum(Dfje),Lender_Sl=Sum(dfsl) FROM Cwzz_V_AccVouch "
    
    If TjAss = "" Then         '无辅助项目核算时
        Sqlstr = Sqlstr + "Where " & TjList & " "
    Else
        Sqlstr = Sqlstr + "Where " & TjList & " and " & TjAss & " "
    End If
    
    '若不包含未记帐凭证，再增加一个限制
    If Chk_Vouch.Value = 0 Then
        Sqlstr = Sqlstr & " and BookFlag='1'"
    End If
    Sqlstr = Sqlstr + " and Year='" & Int_Year & "'  and Period<='" & Int_Period & "' group by ccode "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '计算期末余额
    If RecTemp.EOF = False Then
        Je = Je + Val(RecTemp.Fields("Debi_je") & "") - Val(RecTemp.Fields("Lender_je") & "")
        Sl = Sl + Val(RecTemp.Fields("Debi_sl") & "") - Val(RecTemp.Fields("Lender_sl") & "")
    End If
    
    '再搜索总帐中是否存在该辅助条件的记录,若存在则不参与计算,因为在上面的明细帐汇总时已经计算过,需要剔除掉.
    If TjAss = "" Then
        Sqlstr = "SELECT * from  Cwzz_AccSum  where " & TjMain & " and Year='" & Int_Year & "' and period=1 " '从科目总帐取年初余额"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    Else
        Sqlstr = "select * from Cwzz_AccSumAssi  where " & TjMain & "and " & TjAss & " and Year='" & Int_Year & "' and period=1"    '从辅助总帐取年初余额
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    End If
    If RecTemp.EOF = False Then
        Je = 0
        Sl = 0
    End If
End Sub


Private Sub Save_TempPz_Main(TranVouchClass1 As String, TranNo As String, OperationNum1 As Integer, VouchIdTemp_Id As Long) '将有效数据写入临时凭证主表。（先写辅表再写主表，为了防止在主表中写入没有发生额的空凭证记录）
    Dim Rec_VouchMainTemp As New ADODB.Recordset           '临时凭证主表记录集
    
    '打开临时凭证主表，用于存放有效凭证的凭证号等信息
    If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
    Rec_VouchMainTemp.Open "select * from Cwzz_AccVouchMainTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rec_VouchMainTemp
        .AddNew
        .Fields("VouchId") = VouchIdTemp_Id              '转帐过程序号
        .Fields("Year") = Int_Year                           '取选中的年份
        .Fields("period") = Int_Period                       '取选中的会计期间
        .Fields("Ddate") = Xtrq                              '取系统日期
        .Fields("VouchClassCode") = TranVouchClass1          '所转转帐过程的凭证类别
        .Fields("Doc") = 0
        .Fields("Bill") = Xtczy
        .Fields("VouchSource") = "自动转帐"                  '凭证来源
        .Fields("OperationClass") = ""                       '业务类型
        .Fields("BillType") = ""
        .Fields("BillNo") = TranNo                           '存放转帐过程编码
        .Fields("OperationNo") = OperationNum1               '存放批号
        .Fields("DeleteFlag") = IIf(Bln_DeleteFlag, 1, 0)
        
        .Update
    End With
End Sub

Private Function Tran_Pd() As Boolean            '转帐之前的判断
    Dim jsq As Long             '临时计数器
    '提示已转过的凭证是否再转一次
    With CzxsGrid
        For jsq = .FixedRows To .Rows - 1
            If .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = "√" Then
                If .TextMatrix(jsq, Sydz("005", GridStr(), Szzls)) <> "" Then
                    Tsxx = "第" & CzxsGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) & "号已转过凭证，再转一次吗？"
                    If Xtxxts(Tsxx, 1, 4) = 7 Then
                        .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = ""
                    End If
                End If
            End If
        Next jsq
    End With
    
    '判断选择的转帐过程共几个，保存在TranJsq中。将每个转帐过程编号赋值到TranNum（）数组中，
    ReDim TranNum(1)                            '转帐过程数组附初值
    TranJsq = 0
    With CzxsGrid
        For jsq = .FixedRows To .Rows - 1
            If .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = "√" Then
                If TranJsq = 0 Then
                    TranNum(1) = .TextMatrix(jsq, Sydz("001", GridStr(), Szzls))
                End If
                If TranJsq > 0 Then
                    ReDim Preserve TranNum(UBound(TranNum) + 1)
                    TranNum(TranJsq + 1) = .TextMatrix(jsq, Sydz("001", GridStr(), Szzls))
                End If
                TranJsq = TranJsq + 1
            End If
        Next jsq
    End With
    If TranJsq = 0 Then
        Tsxx = "没有选择转帐过程!"
        Call Xtxxts(Tsxx, 0, 4)
        Tran_Pd = False
        Exit Function
    End If
    Jsq_Eff = TranJsq               '假设选择的转帐过程全部有效
    
    '将每个转帐过程的凭证类别放到数组TranVouchClass中
    ReDim TranVouchClass(1)
    For jsq = 1 To TranJsq
        Sqlstr = "SELECT * FROM Cwzz_AutoTranMain where TranCode='" & TranNum(jsq) & "'and tranclass='" & TranClassCode & "'"
        Set Rec_AutoTranMain = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If jsq > 1 Then
            ReDim Preserve TranVouchClass(UBound(TranVouchClass) + 1)
        End If
        TranVouchClass(jsq) = Trim(Rec_AutoTranMain.Fields("VouchClassCode") & "")
    Next jsq
    
    '取操作批号OperationNum，需唯一。
    OperationNum = CreatBillID("0102")
    RecTemp.Cl