VB开发的ERP系统

    Select Case VouchModel
        Case "3"                      '借银行存款，借财务费用，贷应收票据（贴现、背书）
            '1写借银行存款或应付帐款
            YbJe = YbCash  '贴现、背书金额
            BbJe = BbCash
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
             
             '2借财务费用
            YbJe = YbPmJe + YbPmInterest - YbCash '财务费用＝票面金额+票面利息－贴现金额
            BbJe = BbPmJe + BbPmInterest - BbCash
            If YbJe <> 0 Or BbJe <> 0 Then
               VouchRow = VouchRow + 1
               Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeExpense, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
            End If
            '3贷应收票据
            YbJe = YbPmJe + YbPmInterest         '票面金额+票面利息
            BbJe = BbPmJe + BbPmInterest
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeNote, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
        Case "4"                      '借银行存款，贷应收票据（兑现,转出）      '
            '写借银行存款、应收、应付
            YbJe = YbCash            '兑现金额
            BbJe = BbCash
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
             
             '贷应收票据
            YbJe = YbPmJe + YbPmInterest
            BbJe = BbPmJe + BbPmInterest
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeNote, 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
    Dim BillIdAr As Long                        '应收单ID
    Dim BillIdAp 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
                    BillIdAr = Val(CxbbGrid.TextMatrix(jsq, 2))             '应收单ID
                    BillIdAp = Val(CxbbGrid.TextMatrix(jsq, 3))             '付款单ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_NoteClose set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where NoteCloseID='" & EffectListId & "'")
        
                    '转出处理时，需要将生成的凭证记录到其它应收单和明细帐中
                    If BillIdAr <> 0 Then             '应收单记录ID
                       
                       '写其它应收单中
                       Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAr & "'")
                       
                       '写明细帐中
                       Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAr & "' and BillItemCode like '2%'")
                    End If
                    
                    '当背书处理时，需要将生成的凭证记录到付款单和明细帐中
                    If BillIdAp <> 0 Then            '付款单记录ID
                             
                       '写付款单中
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAp & "'")
                       '将明细帐中
                       Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAp & "' and BillItemCode like '9%'")
                    End If
                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 & "'")
                  
                    '将生成的凭证号记录到对应单据中（背书和转出时用）
                    Sqlstr = "SELECT BillIdAr,BillIdAp FROM RP_NoteClose WHERE NoteCloseId='" & EffectListId & "' and RpFLag='AR' "
                    Set Rec_NoteClose = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If Val(Trim(Rec_NoteClose.Fields("BillIdAr") & "")) <> 0 Then
                        BillIdAr = Rec_AccList.Fields("BillIdAr")        '变动单中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAr & "'")
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAr & "' and BillItemCode like '2%'")
                    End If
                    If Val(Trim(Rec_NoteClose.Fields("BillIdAp") & "")) <> 0 Then
                        BillIdAp = Rec_AccList.Fields("BillIdAp")        '变动单中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAp & "'")
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAp & "' and BillItemCode like '9%'")
                    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