VB开发的ERP系统

             Next JsqTemp
        Case False           '不合并
             For JsqTemp = 1 To TranJsq
                If JsqTemp = 1 Then
                    Main = True
                Else
                    If JsqTemp > 1 Then
                        If TranCancelNo(JsqTemp) <> TranCancelNo(JsqTemp - 1) Then
                            Main = True
                        Else
                            Main = False
                        End If
                    End If
                End If
                If Main = True Then
                    lng_OperationNum = CreatBillID("0102")                  '临时凭证ID号
                    '写临时凭证主表
                    VouchRow = 0
                    Call Save_TempPz_Main(TranVouchClass(JsqTemp), TranCancelNo(JsqTemp), OperationNum, lng_OperationNum) '参数是凭证类别，行号，批号，凭证ID
                    '根据应收明细帐记录，写临时凭证子表
                    Call Save_TempPz_Ass_Pre(lng_OperationNum, TranCancelNo(JsqTemp), VouchModelType(JsqTemp), JsqTemp)
                End If
             Next JsqTemp
    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, TranCancelNo As Long, VouchModel As String, serial As Integer)
    'VouchTemp_Id 表示临时凭证的ID号，TranCancelNo 表示选择的需要生成凭证的核销批号，VouchModel 表示凭证的模板，serial 表示临时凭证子表中的记录顺序号
    Dim RecTemp As New ADODB.Recordset      '临时记录集
    Dim jsq As Long
    
    Dim Digest As String                    '摘要
    Dim AccCodeArAp As String               '应收科目编码
    Dim DeptCode As String                  '部门编码
    Dim PersonCode As String                '经办人编码
    Dim CusCode As String                   '客户编码
    Dim SuppCode As String                  '供应商编码
    Dim ItemCode As String                  '项目编码
    Dim BillRPFlag As String                '明细帐中记录的单据的应收应付标识
    
    Sqlstr = "SELECT * FROM Ap_v_CancelVouch WHERE CancelNo='" & TranCancelNo & "' and rpflag='" & ArApFlag & "' Order by CancelId"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
    
    '取明细帐记录
    jsq = 1
    Do While RecTemp.EOF = False
        Digest = Trim(RecTemp.Fields("Digest") & "")                        '摘要
        AccCodeArAp = Trim(RecTemp.Fields("AccCodeArAp") & "")              '单据科目
        DeptCode = Trim(RecTemp.Fields("DeptCode") & "")                    '部门
        PersonCode = Trim(RecTemp.Fields("PersonCode") & "")                '经办人编码
        CusCode = Trim(RecTemp.Fields("CusCode") & "")                      '客户
        SuppCode = Trim(RecTemp.Fields("SupplierCode") & "")                '供应商
        ItemCode = ""                                                       '项目
        AccRate = Val(Trim(RecTemp.Fields("AccRate") & ""))                 '记帐汇率
        BankBillNo = ""                                                     '银行票号
        SsCode = ""                                                         '结算方式编码
        ForeignCurrCode = Trim(RecTemp.Fields("ForeignCurrCode") & "")      '外币编码
        BillDate = CDate(Trim(RecTemp.Fields("CancelDate") & ""))           '核销日期
        BillRPFlag = Trim(RecTemp.Fields("BillRPFlag") & "")                '该记录在明细帐中所属应收应付标识
        PersonName = Trim(RecTemp.Fields("PersonName") & "")                '经办人姓名
        YbJe = Val(Trim(RecTemp.Fields("YbCancelje") & ""))                 '原币金额
        BbJe = Val(Trim(RecTemp.Fields("BbCancelje") & ""))                 '本币金额
        BillItemCode = Trim(RecTemp.Fields("BillItemCode") & "")            '单据类型
        CusName = ""
        SuppName = ""
        VouchRow = VouchRow + 1
        Select Case VouchModel
            Case "PA"      '应付冲应收
                '贷应收帐款
                If BillRPFlag = "Ar" Or BillRPFlag = "AR" Then '
                    Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeArAp, DeptCode, PersonCode, CusCode, SuppCode, ItemCode, "贷")
                Else
                    '借应付帐款分录
                    Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeArAp, DeptCode, PersonCode, CusCode, SuppCode, ItemCode, "借")
                End If
        End Select
        RecTemp.MoveNext
        jsq = jsq + 1
    Loop
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 = " CancelItemCode='" & MenuBillCode & "' and RPFlag='" & ArApFlag & "'"
    
    '填充表单上的日期和凭证类别
    LabDate.Caption = Xtrq                                        '生成凭证日期
    Rec = "RP_Cancel"                           '核销关系表
End Sub

Private Sub WriteVouchId()                      '回写正式凭证ID到单据表和明细帐表中
    Dim Rec_VouchMain As New ADODB.Recordset    '临时主凭证记录
    Dim EffectListId As Long                    '已经保存为正式凭证的明细帐中的记录ID（即有效的明细帐记录）
    Dim EffectVouchId As Long                   '生成正式凭证的凭证ID
    Dim CancelNoTemp As Long                    '核销编号
    
    Dim AccListBillId As Long                   '明细帐中记录的单据的ID
    Dim Rec_AccList As New ADODB.Recordset      '明细帐记录集
    Dim Rec_Cancel 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
                
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")   '已生成的正式凭证的ID
                    CancelNoTemp = TranCancelNo(jsq)                      '核销编号

                    '将生成的凭证记录到明细帐中
                    Sqlstr = "SELECT YFId As AccListId FROM RP_Cancel WHERE CancelNo='" & CancelNoTemp & "'"
                    Set Rec_Cancel = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    Do While Rec_Cancel.EOF = False
                        EffectListId = Val(Trim(Rec_Cancel.Fields("AccListId") & ""))           '明细帐ID
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where AccListID='" & EffectListId & "'")
                        Rec_Cancel.MoveNext
                    Loop
                    
                    '将生成的凭证记录到核销关系中
                    If Rec <> "" Then
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where CancelNo='" & CancelNoTemp & "'")
                    End If
                Next jsq
            Case False          '如果凭证单张生成，则按临时凭证主表中记录的AccListId(jsq)回写数据。
                Do While Rec_VouchMain.EOF = False
                    
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")   '已生成的正式凭证的ID
                    CancelNoTemp = Val(Rec_VouchMain.Fields("BillNo"))    '核销编号

        
                    '将生成的凭证记录到明细帐中
                    Sqlstr = "SELECT YFId As AccListId FROM RP_Cancel WHERE CancelNo='" & CancelNoTemp & "'"
                    Set Rec_Cancel = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    Do While Rec_Cancel.EOF = False
                        EffectListId = Val(Trim(Rec_Cancel.Fields("AccListId") & ""))           '明细帐ID
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where AccListID='" & EffectListId & "'")
                        Rec_Cancel.MoveNext
                    Loop
                    
                    '将生成的凭证记录到核销关系中
                    If Rec <> "" Then
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where CancelNo='" & CancelNoTemp & "'")
                    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