VB开发的ERP系统

             For jsq = 1 To TranJsq
                 lng_OperationNum = CreatBillID("0102")                  '临时凭证ID号
             
                 '写临时凭证主表
                 VouchRow = 0
                 Call Save_TempPz_Main(TranVouchClass(jsq), FiltListId(jsq), OperationNum, lng_OperationNum)  '参数是凭证类别，行号，批号，凭证ID
             
                 '根据应收明细帐记录，写临时凭证子表
                 Call Save_TempPz_Ass_Pre(lng_OperationNum, FiltListId(jsq), VouchModelType(jsq), jsq)
             Next jsq
    End Select
    Cw_DataEnvi.DataConnect.CommitTrans
    '记录此次转帐的批号，做为凭证窗体调用的参数
    
    '】以上是写临时凭证记录
    
    AutoTran_PzFrm.vouchsourcePz = "应收系统"          '
    
    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 Integer)
    'VouchTemp_Id 表示临时凭证的ID号，AccList_Id 表示选择的需要生成凭证的明细帐记录的ID，VouchModel 表示凭证的模板，serial 表示临时凭证子表中的记录顺序号
    Dim RecTemp As New ADODB.Recordset      '临时记录集
    
    Dim Digest As String                    '摘要
    Dim AccCode As String                   '单据科目编码
    Dim AccCodeArAp As String               '应收科目编码
    Dim DeptCode As String                  '部门编码
    Dim PersonCode As String                '经办人编码
    Dim CusCode As String                   '客户编码
    Dim SupplierCode As String              '供应商编码
    Dim ItemCode As String                  '项目编码
    
    
    Sqlstr = "SELECT * FROM Ar_v_AccListVouch WHERE AccListId='" & AccList_Id & "' AND RPFLAG='AR' "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
    '取明细帐记录
    Digest = Trim(RecTemp.Fields("Digest") & "")                        '摘要
    AccCode = Trim(RecTemp.Fields("AccCode") & "")                      '单据科目
    AccCodeArAp = Trim(RecTemp.Fields("AccCodeArAp") & "")              '应收科目
    DeptCode = Trim(RecTemp.Fields("DeptCode") & "")                    '部门
    PersonCode = Trim(RecTemp.Fields("PersonCode") & "")                '经办人编码
    CusCode = Trim(RecTemp.Fields("PsCode") & "")                       '客户
    SupplierCode = ""                                                   '供应商
    ItemCode = ""                                                       '项目
    AccRate = Val(Trim(RecTemp.Fields("AccRate") & ""))                 '记帐汇率
    BankBillNo = Trim(RecTemp.Fields("BankBillNo") & "")                '银行票号
    SsCode = Trim(RecTemp.Fields("SsCode") & "")                        '结算方式编码
    ForeignCurrCode = Trim(RecTemp.Fields("ForeignCurrCode") & "")      '外币编码
    BillDate = CDate(Trim(RecTemp.Fields("BillDate") & ""))             '单据日期
    PersonName = Trim(RecTemp.Fields("PersonName") & "")                '经办人姓名
    CustName = Trim(RecTemp.Fields("CusName") & "")                     '客户名称
    SuppName = ""

    Select Case Trim(RecTemp.Fields("BillItemCode"))
        Case "20", "21"                                                 '其它应收单、代垫费用单
            YbJe = Trim(RecTemp.Fields("YbYsJe") & "")                  '原币金额
            BbJe = Trim(RecTemp.Fields("BbYsJe") & "")                  '本币金额
        Case "30", "31", "32"                                           '到款结算、预收单、退款单
            YbJe = Trim(RecTemp.Fields("YbSsJe") & "")                  '原币金额
            BbJe = Trim(RecTemp.Fields("BbSsJe") & "")                  '本币金额
    End Select
    Select Case VouchModel
        Case "1"                '借应收，贷其它科目
            '写借应收帐款分录
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeArAp, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")

            '贷应收帐款对应分录
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
        Case "2"                '贷应收，借其它科目
            '借应收帐款对应分录
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
            
            '贷应收帐款分录
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeArAp, 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 = True 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
            .Fields("BillDate") = BillDate
        End If
        ']银行结算信息
        
        .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
    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                                        '生成凭证日期
    Select Case MenuBillCode
        Case "2"                                                '其它应收款'代垫费用单
            Rec = "RP_OtherBill"
            RecBillId = "OtherBillId"
        Case "3"                                                '收款单、预收单、退款单
            Rec = "RP_CloseBill"
            RecBillId = "CloseBillId"
    End Select
End Sub

Private Sub WriteVouchId()                      '回写正式凭证ID到单据表和明细帐表中
    Dim Rec_VouchMain As New ADODB.Recordset    '临时主凭证记录
    Dim EffectListId As Long                    '已经保存为正式凭证的明细帐中的记录ID（即有效的明细帐记录）
    Dim EffectVouchId As Long                   '生成正式凭证的凭证ID
    
    Dim AccListBillId As Long                   '明细帐中记录的单据的ID
    Dim Rec_AccList As New ADODB.Recordset      '明细帐记录集
    
    
        
    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           '如果凭证合并生成，则按网格中记录的AccListId(jsq)来回写数据，因为这种情况下，临时凭证主表中存放的是批号。
                For jsq = 1 To TranJsq
                    '将生成的凭证ID记录到明细帐中
                    EffectListId = FiltListId(jsq)                           '已经生成凭证的明细帐AccListId
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")      '已生成的正式凭证的ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where AccListID='" & EffectListId & "'")
        
                    '将生成的凭证记录到单据中
                    If Rec <> "" Then
                        Sqlstr = "SELECT BillId FROM RP_AccList WHERE AccListId='" & EffectListId & "'"
                        Set Rec_AccList = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                        AccListBillId = Rec_AccList.Fields("BillId")        '明细帐中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & AccListBillId & "'")
                    End If
                Next jsq
            Case False          '如果凭证单张生成，则按临时凭证主表中记录的AccListId(jsq)回写数据。
                Do While Rec_VouchMain.EOF = False
        
                    '将生成的凭证记录到明细帐中
                    EffectListId = Rec_VouchMain.Fields("BillNo")         '已经生成凭证的明细帐AccListId
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")   '已生成的正式凭证的ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where AccListID='" & EffectListId & "'")
        
                    '将生成的凭证记录到单据中
                    If Rec <> "" Then
                        Sqlstr = "SELECT BillId FROM RP_AccList WHERE AccListId='" & EffectListId & "'"
                        Set Rec_AccList = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                        AccListBillId = Rec_AccList.Fields("BillId")        '明细帐中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & AccListBillId & "'")
                    End If
                    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