VB开发的ERP系统

                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.Lab_OperNum.Caption = OperationNum
        
        '调入凭证制作窗体
        AutoTran_PzFrm.Show 1
        
        
        '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
        Call Write_Date
        Call Clean
    End If
    Call Cxnrtcwg
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
    Tsxx = Err.Description
    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 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_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
            
            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.Lab_OperNum.Caption = OperationNum
        
        '调入凭证制作窗体
        AutoTran_PzFrm.Show 1
        
        
        '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
        Call Write_Date
        Call Clean
    End If
    Call Cxnrtcwg
    Exit Sub
    
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
    Tsxx = Err.Description
    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 Re