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

    Yhanswer = Xtxxts(Tsxx, 2, 2)
    If Yhanswer = 2 Then
        Exit Sub
    End If
    On Error GoTo Cwcl
    
    Cw_DataEnvi.DataConnect.BeginTrans
    Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranItem where TranCode= '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
    Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranMain where TranCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
    Cw_DataEnvi.DataConnect.CommitTrans
    
    CzxsGrid.RemoveItem CzxsGrid.Row
    Exit Sub
    
Cwcl:
    If Err.Number = -2147217900 Then
        Tsxx = "该编码已经被使用,不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    Else
        Tsxx = "出现未知情况,该编码不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
End Sub


Public Sub Define()             '定义转帐关系
    
    Dim gnsybm As String      '功能索引编码
    Dim gnsymc As String      '功能索引名称
    If CzxsGrid.Rows = CzxsGrid.FixedRows Then
        Tsxx = "请首先新增转帐过程!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
    If Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) = "" Then
        Tsxx = "请选择转帐过程!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    Else
        '为转帐定义窗体传递该转帐过程参数
        CzxsGrid.Tag = CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))
        Sqlstr = "Select * From Xt_xtgnb where gnmc='" & Xt_Control.tvTreeView.SelectedItem.Text & "'"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        gnsybm = Trim(RecTemp.Fields("gnsy") & "")
        gnsymc = Trim(RecTemp.Fields("gnmc") & "")
        Select Case gnsybm
        Case "Cwzz_UserDefineTran"                                 '"自定义转帐凭证"
            AutoTran_DefiMy.HelpContextID = AutoTran_TranList.HelpContextID
            AutoTran_DefiMy.Show 1
        Case "Cwzz_ProfitTran"                                     '"期间损益结转"
            AutoTran_DefiSy.HelpContextID = AutoTran_TranList.HelpContextID
            AutoTran_DefiSy.Show 1
        Case "Cwzz_ModelTran"                                      '"模式结转凭证"
            AutoTran_DefiCus.HelpContextID = AutoTran_TranList.HelpContextID
            AutoTran_DefiCus.Show 1
        Case "Cwzz_ExchangeTran"                                   '"汇兑损益凭证"
            AutoTran_DefiExchange.HelpContextID = AutoTran_TranList.HelpContextID
            AutoTran_DefiExchange.Show 1
        End Select
    End If
    
End Sub

Private Sub Run1()                                          '执行自定义转帐程序
    
    Dim Tj_Main As String                                   '总帐取数公式
    Dim Tj_List As String                                   '明细帐取数公式
    Dim Tj_Ass As String                                    '辅助帐取数公式
    
    Dim jsq As Integer                                      '临时计数器
    Dim I As Integer
    Dim Str_Formula As String                               '公式串
    Dim DestTranOri As String                               '对方汇总数的借贷方向
    Dim lng_OperationNum As Long
    Bln_DeleteFlag = True
    
    If Tran_Pd = False Then
        Exit Sub
    End If
    
    On Error GoTo Err1
    Cw_DataEnvi.DataConnect.BeginTrans
    
    TranCount = TranJsq          '记录生成凭证的个数
    VoidStr = ""         '记录没有数值的空凭证序号
    
    '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
    For jsq = 1 To TranJsq
        
        '写临时凭证主表
        lng_OperationNum = CreatBillID("0102")
        Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
        
        '对方汇总数的借贷方向
        Sqlstr = "Select ccode,TranOri,FormulaString from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' Order by AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Rec_AutoTranItem.EOF = False Then
            DestTranOri = Rec_AutoTranItem.Fields("tranori")
        End If
        
        Jhj = 0
        Dhj = 0   '对方汇总金额
        Jhjsl = 0
        Dhjsl = 0
        JhjItemSl = 0
        DhjItemSl = 0
        I = 0
        hjje = 0      '合计金额
        '按转帐定义关系，取每笔转帐数据，写入临时数据辅表中
        Sqlstr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString not like '%对方汇总数%' ORDER BY AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        Do While Rec_AutoTranItem.EOF = False
            
            Str_Formula = Trim(Rec_AutoTranItem.Fields("FormulaString"))
            Str_Formula = Fn_Replace(Str_Formula, Chk_Vouch.Value)
            
            Sqlstr = "select " & Str_Formula & " as ReturnValue"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.EOF = False Then
                Je = IIf(IsNull(RecTemp.Fields("ReturnValue")), 0, RecTemp.Fields("ReturnValue"))
                If Rec_AutoTranItem.Fields("tranori") <> DestTranOri Then
                    Dhj = Dhj + Je * IIf(Rec_AutoTranItem.Fields("tranori") = DestTranOri, -1, 1)
                End If
                
                '写临时凭证辅表
                If Je <> 0 Then
                    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")))
                End If
            End If
            Rec_AutoTranItem.MoveNext
            I = I + 1
            hjje = hjje + Je
        Loop
        
        '对方汇总
        Sqlstr = "Select ccode,TranOri,FormulaString from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' Order by AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Rec_AutoTranItem.EOF = False Then
            DestTranOri = Rec_AutoTranItem.Fields("tranori")
        End If
        
        '找到数据来源为对方汇总数的转帐关系
        Sqlstr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' ORDER BY AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        Do While Rec_AutoTranItem.EOF = False
            
            Str_Formula = Trim(Rec_AutoTranItem.Fields("FormulaString"))
            Str_Formula = Replace(Str_Formula, "对方汇总数", Str(Dhj))
            
            Sqlstr = "select " & Str_Formula & " as ReturnValue"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.EOF = False Then
                Je = RecTemp.Fields("ReturnValue")
            End If
            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
            I = I + 1
        Loop
        
        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

Private Sub Run3()                                          '执行汇兑损益程序
    
    Dim Tj_Main As String                                   '总帐取数公式
    Dim Tj_List As String                                   '明细帐取数公式
    Dim Tj_Ass As String                                    '辅助帐取数公式
    
    Dim jsq As Integer                                      '临时计数器
    Dim I As Integer
    Dim Str_Formula As String                               '公式串
    Dim DestTranOri As String                               '对方汇总数的借贷方向
    Dim Str_ForeignCode As String                           '外币编码
    Dim Dec_AdjustRate As Double                            '汇率
    Dim lng_OperationNum As Long
    Bln_DeleteFlag = True
    
    If Tran_Pd = False Then
        Exit Sub
    End If
    
    On Error GoTo Err1
    Cw_DataEnvi.DataConnect.BeginTrans
    
    TranCount = TranJsq          '记录生成凭证的个数
    VoidStr = ""         '记录没有数值的空凭证序号
    
    '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
    For jsq = 1 To TranJsq
        
        '写临时凭证主表
        
        lng_OperationNum = CreatBillID("0102")
        Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
        
        '对方汇总数的借贷方向
        Sqlstr = "Select ccode,TranOri from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 Order by AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Not Rec_AutoTranItem.EOF Then
            DestTranOri = Rec_AutoTranItem.Fields("tranori")
        End If
        
        Jhj = 0
        Dhj = 0   '对方汇总金额
        Jhjsl = 0
        Dhjsl = 0
        JhjItemSl = 0
        DhjItemSl = 0
        I = 0
        hjje = 0      '合计金额
        '按转帐定义关系，取每笔转帐数据，写入临时数据辅表中
        Sqlstr = "select * from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=1 ORDER BY AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        Do While Rec_AutoTranItem.EOF = False
            
            Str_Formula = Trim(Rec_AutoTranItem.Fields("ccode"))
            Str_ForeignCode = Trim(Rec_AutoTranItem.Fields("ForeigncurrCode"))
            
            If RecTemp.State = 1 Then RecTemp.Close
            Sqlstr = "select AdjustRate from Gy_ForeignCurrency where ForeignCurrCode='" & Str_ForeignCode & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.EOF = False Then
                Dec_AdjustRate = RecTemp.Fields("AdjustRate")
            End If
            
            If RecTemp.State = 1 Then RecTemp.Close
            Sqlstr = "select ccode,qmye,qmwb from Cwzz_AccSum where ccode='" & Str_Formula & "' and year=" & Xtyear & " and period=" & Xtmm
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.EOF = False Then
                Je = RecTemp.Fields("qmwb") * Dec_AdjustRate - RecTemp.Fields("qmye")
                Je = Je * IIf(Rec_AutoTranItem.Fields("tranori") = Rec_AutoTranItem.Fields("BalanceOri"), 1, -1)
                Dhj = Dhj + Je * IIf(Rec_AutoTranItem.Fields("tranori") = DestTranOri, -1, 1)
                
                '写临时凭证辅表
                If Je <> 0 Then
                    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")))
                End If
            End If
            Rec_AutoTranItem.MoveNext
            I = I + 1
            hjje = hjje + Je
        Loop
        
        '对方汇总
        Sqlstr = "Select ccode,TranOri from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 Order by AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Rec_AutoTranItem.EOF = False Then
            DestTranOri = Rec_AutoTranItem.Fields("tranori")
        End If
        
        '找到数据来源为对方汇总数的转帐关系
        Sqlstr = "select * from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 ORDER BY AutoTranId"
        Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        Do While Rec_AutoTranItem.EOF = False