VB开发的ERP系统

        Case True           '合并为1张凭证
             lng_OperationNum = CreatBillID("0102")                      '临时凭证ID号
             
             '写临时凭证主表
             VouchRow = 1
             Call Save_TempPz_Main(TranVouchClass(1), OperationNum, OperationNum, lng_OperationNum)  '参数是凭证类别，行号，批号，凭证ID,对合并生成凭证时，行号没有意义
             
             '根据应付明细帐记录，写临时凭证子表
             For jsq = 1 To TranJsq
                 Call Save_TempPz_Ass_Pre(lng_OperationNum, FiltListId(jsq), VouchModelType(jsq), jsq, TranNoteCode(jsq))
             Next jsq
        Case False           '不合并
             For jsq = 1 To TranJsq
                 lng_OperationNum = CreatBillID("0102")                  '临时凭证ID号
             
                 '写临时凭证主表
                 VouchRow = 1
                 Call Save_TempPz_Main(TranVouchClass(jsq), FiltListId(jsq), OperationNum, lng_OperationNum)  '参数是凭证类别，行号，批号，将来凭证形成ID
             
                 '根据应付明细帐记录，写临时凭证子表
                 Call Save_TempPz_Ass_Pre(lng_OperationNum, FiltListId(jsq), VouchModelType(jsq), jsq, TranNoteCode(jsq))
             Next jsq
    End Select
    Cw_DataEnvi.DataConnect.CommitTrans
    '记录此次转帐的批号，做为凭证窗体调用的参数
    
    '】以上是写临时凭证记录
    
    AutoTran_PzFrm.OperationNumPz = OperationNum       '传递此次转帐批号
    
    AutoTran_PzFrm.Show 1  '临时转帐凭证窗体
    
    
    Call WriteVouchId
    Call Clean
    Call Sub_Query(1)
    Exit Sub

ERR1:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = Err.Description
    'Tsxx = "转帐过程中出现未知错误，程序自动恢复保存前状态！"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
End Sub
Private Sub Save_TempPz_Ass_Pre(VouchTemp_Id As Long, AccList_Id As Long, VouchModel As String, serial As Long, TranNoteCode As String)
    'VouchTemp_Id 表示临时凭证的ID号，AccList_Id 表示选择的需要生成凭证的明细帐记录的ID，VouchModel 为形成凭证的模板编号，serialnum 表示临时凭证子表中的记录顺序号
    Dim RecNote As New ADODB.Recordset            '应付票据记录集
    Dim RecNoteChange As New ADODB.Recordset      '票据变动记录集
    
    Dim Digest As String                    '摘要
    Dim AccCode As String                   '业务科目编码
    Dim AccCodeNote As String               '应付票据科目编码
    Dim AccCodeInterest As String           '利息科目编码
    Dim AccCodeExpense As String            '费用科目编码
    
    Dim DeptCode As String                  '部门编码
    Dim PersonCode As String                '经办人编码
    Dim CusCode As String                   '客户编码
    Dim SupplierCode As String              '供应商编码
    Dim ItemCode As String                  '项目编码
    
    Dim YbPmJe As Double                    '原币票面金额
    Dim BbPmJe As Double                    '本币票面金额
    
    Dim YbCash As Double                    '原币变动金额
    Dim BbCash As Double                    '本币变动金额
    
    Sqlstr = "SELECT * FROM Ap_v_NoteClose WHERE NoteCloseId='" & AccList_Id & "' AND RPFLAG='AP' "
    Set RecNoteChange = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    Sqlstr = "SELECT * FROM RP_Note WHERE NoteCode='" & TranNoteCode & "' AND RPFLAG='AP'"
    Set RecNote = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '应付票据票面数据
    With RecNote
        YbPmJe = Val(Trim(.Fields("YbSsJe") & ""))                   '原币票面金额
        BbPmJe = Val(Trim(.Fields("BbSsJe") & ""))                   '本币票面金额
    End With
    
    '取变动单数据
    With RecNoteChange
        Digest = Trim(.Fields("Digest") & "") & Trim(.Fields("NoteCode") & "") '摘要
        AccCode = Trim(.Fields("AccCode") & "")                                '业务科目
        AccCodeNote = Trim(.Fields("AccCodeNote") & "")                        '应付票据科目
        DeptCode = Trim(.Fields("DeptCode") & "")                    '部门
        PersonCode = Trim(.Fields("PersonCode") & "")                '经办人编码
        SupplierCode = Trim(.Fields("PsCode") & "")                  '供应商
        CusCode = ""                                                 '客户
        ItemCode = ""                                                '项目
        AccRate = Val(Trim(.Fields("AccRate") & ""))                 '记帐汇率
        BankBillNo = Trim(.Fields("BankBillNo") & "")                '银行票号
        SsCode = Trim(.Fields("SsCode") & "")                        '结算方式编码
        ForeignCurrCode = Trim(.Fields("ForeignCurrCode") & "")      '外币编码
        BillDate = CDate(Trim(.Fields("CloseDate") & ""))            '单据日期
        PersonName = Trim(.Fields("PersonName") & "")                '经办人姓名
        YbCash = Val(Trim(.Fields("YbCash") & ""))                   '原币变动金额
        BbCash = Val(Trim(.Fields("BbCash") & ""))                   '本币变动金额
        CustName = ""                                                '客户名称
        SuppName = Trim(.Fields("SupplierName") & "")               '供应商名称
    End With
    Select Case VouchModel
        Case "P4"                      '借应付票据，贷银行存款
        
             '借应付票据
            YbJe = YbPmJe + YbPmInterest
            BbJe = BbPmJe + BbPmInterest
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeNote, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
            
            YbJe = YbCash               '贷付款金额
            BbJe = BbCash
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")

    End Select
End Sub

Private Sub Save_TempPz_Main(TranVouchClass1 As String, TranNo As Long, OperationNum1 As Long, 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("VouchSource") = "应付系统"                  '凭证来源
        .Fields("OperationNo") = OperationNum1               '存放批号
        .Fields("VouchId") = VouchIdTemp_Id                  '临时凭证ID
        .Fields("Year") = Int_Kjyear                         '取选中的年份
        .Fields("period") = Int_Period                       '取选中的会计期间
        .Fields("Ddate") = Xtrq                              '取系统日期
        .Fields("VouchClassCode") = TranVouchClass1          '凭证类别
        .Fields("Doc") = 0
        .Fields("Bill") = Xtczy
        .Fields("OperationClass") = ""                       '业务类型
        .Fields("BillType") = ""
        .Fields("BillNo") = Str(TranNo)                      '存放行号
        .Fields("DeleteFlag") = IIf(Bln_DeleteFlag, 1, 0)
        
        .Update
    End With
End Sub

Private Sub Save_TempPz_Ass(VouchIdTemp_Id As Long, serialnum As Long, Str_Digest As String, Str_Kmh As String, str_Dept As String, Str_Per As String, Str_Cus As String, Str_Sup As String, Str_Item As String, str_TranOri As String) '写临时凭证辅表
    'VouchIdTemp_Id临时凭证主表、辅表对应关系Id号
    Dim Rec_VouchTemp As New ADODB.Recordset            '临时凭证辅表记录集
    Dim RecTemp As New ADODB.Recordset
    
    '打开临时凭证辅表,用于存放转帐凭证内容
    Rec_VouchTemp.Open "select * from Cwzz_AccVouchsubTemp where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_AccCode where Ccode='" & Str_Kmh & "'")
    With Rec_VouchTemp
        .AddNew
        
        '[公共信息
        If str_TranOri = "贷" Then                               '
            .Fields("WbDfje") = YbJe                             '贷方金额
            .Fields("Dfje") = BbJe
        Else
            .Fields("WbJfje") = YbJe                             '借方金额
            .Fields("Jfje") = BbJe
        End If
        .Fields("Digest") = Str_Digest                            '摘要
        If RecTemp.EOF Then
            .Fields("Ccode") = Null
        Else
            .Fields("Ccode") = Str_Kmh                            '转帐科目号
        End If
        .Fields("VouchId") = VouchIdTemp_Id                      '与主表的对应ID
        .Fields("serialID") = serialnum                          '序号ID
        
        
        '[辅助信息
        If RecTemp.EOF = False Then
            If RecTemp.Fields("PersonFlag") = True Then
                .Fields("PersonCode") = Str_Per                  '个人
            End If
            If RecTemp.Fields("DeptFlag") = True Then
                .Fields("DeptCode") = str_Dept                   '部门
            End If
            If RecTemp.Fields("CusFlag") = True Then
                .Fields("CusCode") = Str_Cus                     '客户
            End If
            If RecTemp.Fields("SupplierFlag") = True Then
                .Fields("Suppliercode") = Str_Sup                '供应商
            End If
        End If
        '[币别信息
        .Fields("ForeignCurrCode") = ForeignCurrCode
        .Fields("AccRate") = AccRate

        If RecTemp.EOF = False Then
            '[银行结算信息
            If Trim(RecTemp.Fields("Cproperty")) = "银行" Then
                .Fields("SScode") = SsCode
                .Fields("BillNo") = BankBillNo
                .Fields("Digest") = Str_Digest & CustName & SuppName   '摘要
            End If
        End If
        .Fields("BillDate") = BillDate
        ']银行结算信息
        
        .Fields("TranPerson") = PersonName
        .Update
    End With
End Sub

Private Sub Sub_AllSelect() '全部选中
    Dim jsq As Long
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "√"
       If CxbbGrid.TextMatrix(jsq, 1) = True Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = ""  '单据已制作凭证
       End If
       If Val(CxbbGrid.TextMatrix(jsq, 2)) <> 0 And Trim(CxbbGrid.TextMatrix(jsq, Sydz("010", GridStr(), Szzls))) = "" Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "" '该变动单对应的其它应付单没有审核
       End If
       If Val(CxbbGrid.TextMatrix(jsq, 3)) <> 0 And Trim(CxbbGrid.TextMatrix(jsq, Sydz("010", GridStr(), Szzls))) = "" Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "" '列表中有对应的其它应付单没有审核
       End If
    Next jsq
End Sub
Private Sub Sub_AllCancel() '全部取消
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = ""
    Next jsq

End Sub
Private Sub Sub_Unit() '合并
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "√" Then
            CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "1"
       End If
    Next jsq
End Sub
Private Sub Start()  '初始化表单界面,填充凭证类型
    Dim RecTemp As New ADODB.Recordset
    Dim I As Integer
    
    MenuBillCode_Con = " BillItemCode Like '" & MenuBillCode & "%' and RPFlag='" & ArApFlag & "' "
    
    '填充表单上的日期和凭证类别
    LabDate.Caption = Xtrq                                        '生成凭证日期
    
    Rec = "RP_OtherBill"        '其它应付、应付单数据表
    RecBillId = "OtherBillId"   '其它应付、应付单的单据ID

End Sub

Private Sub WriteVouchId()                      '回写正式凭证ID到单据表和明细帐表中
    Dim Rec_VouchMain As New ADODB.Recordset    '临时主凭证记录集
    Dim EffectListId As Long                    '已经保存为正式凭证的变动表记录ID（即有效的记录）
    Dim EffectVouchId As Long                   '生成正式凭证的凭证ID
    
    Sqlstr = "SELECT * FROM Cwzz_AccVouchMainTemp WHERE SureVouchId>0 and OperationNo='" & OperationNum & "' order by BillNo"
    Set Rec_VouchMain = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Rec_VouchMain.EOF = False Then
        Select Case UnitFlag
            Case True           '如果凭证合并生成，则按网格中记录的NoteCloseId(jsq)来回写数据，因为这种情况下，临时凭证主表中存放的是批号。
                For jsq = 1 To TranJsq
                
                    '将生成的凭证ID记录到变动表中
                    EffectListId = FiltListId(jsq)                          '已经生成凭证的变动单Id
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")     '已生成的正式凭证的ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_NoteClose set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where NoteCloseID='" & EffectListId & "'")
                Next jsq
            Case False          '如果凭证按单张生成，则按临时凭证主表中记录的AccListId(jsq)回写数据。
                Do While Rec_VouchMain.EOF = False
        
                    '将生成的凭证记录到变动表中
                    EffectListId = Rec_VouchMain.Fields("BillNo")         '已经生成凭证的变动单Id
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")   '已生成的正式凭证的ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_NoteClose set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where NoteCloseID='" & EffectListId & "'")
                    Rec_VouchMain.MoveNext
                Loop
        End Select
    End If
End Sub
Private Sub Clean()               '删除临时数据表数据
        '删除临时凭证主从表
        Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchSubTemp Where VouchId in (select VouchId from Cwzz_AccVouchMainTemp where OperationNo='" & OperationNum & "')"
        Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchMainTemp Where OperationNo='" & OperationNum & "'"
End Sub