VB开发的ERP系统

    Dim rectemp As New ADODB.Recordset      '临时记录集
    Dim RecInvoice As New ADODB.Recordset   '发票记录集
    Dim RecAccList 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                  '项目编码
    
    Dim ParaXt As String                    '系统参数
    Dim IsPriceTaxSep As Boolean            '价税是否分开
    Dim InvoiceUnite As Integer             '发票内明细合并条件
    
    Dim YbYsje As Double                    '原币应收
    Dim BbYsje As Double                    '本币应收
    
    ParaXt = "AR_IsInvPriceAndTax"          '价税是否分开
    SqlStr = "Select ItemValue from Gy_AccInformation Where ItemCode='" & ParaXt & "'"
    Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If rectemp.EOF = False Then
        If Trim(rectemp.Fields("itemvalue") & "") = "1" Then     '价税分开
            IsPriceTaxSep = True
        Else
            IsPriceTaxSep = False
        End If
    End If
    ParaXt = "AR_InvUnionType"              '发票内明细合并条件
    SqlStr = "Select ItemValue from Gy_AccInformation Where ItemCode='" & ParaXt & "'"
    Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If rectemp.EOF = False Then
        If rectemp.Fields("itemvalue") = "0" Then  '
            InvoiceUnite = 0                     '第0种方式
        Else
            InvoiceUnite = 1                     '第1种方式
        End If
    End If
    
    Select Case InvoiceUnite                     '发票内记录合并方式
        Case 1
            SqlStr = "SELECT SellAccCode,SellTaxAccCode,Sum(Quantity) as Quantity,Sum(TaxMoney) as TaxMoney,Sum(CapitalTax) as CapitalTax, " & _
             "Sum(InvoiceMoney) as InvoiceMoney,Sum(CapitalMoney) as CapitalMoney,Sum(WholeMoney) as WholeMoney,Sum(CapitalWhole) as CapitalWhole FROM Ar_v_InvoiceVouch " & _
             " where BillCode='" & Invoiceno & "' Group by SellAccCode,SellTaxAccCode "
            Set RecInvoice = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        Case 2
    End Select
    SqlStr = "Select * From Ar_V_AccMxList where BillCode='" & Invoiceno & "'"
    Set RecAccList = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    '取明细帐记录
    With RecAccList
        Digest = "发票号:" & Trim(.Fields("BillCode") & "") & " "
        AccCodeArAp = Trim(.Fields("AccCodeArAp") & "") '应收科目
        DeptCode = Trim(.Fields("DeptCode") & "")                    '部门
        PersonCode = Trim(.Fields("PersonCode") & "")                '经办人编码
        SupplierCode = ""                                            '供应商
        ItemCode = ""                                                '项目
        CusCode = Trim(.Fields("PsCode") & "")                       '客户
        BankBillNo = ""
        PersonName = Trim(.Fields("PersonName") & "")                '经办人姓名
        YbYsje = Val(Trim(.Fields("YbYsJe") & ""))                   '原币金额
        BbYsje = Val(Trim(.Fields("BbYsJe") & ""))                   '本币金额
        BillDate = CDate(Trim(.Fields("BillDate") & ""))             '单据日期
        ForeignCurrCode = Trim(.Fields("ForeignCurrCode") & "")      '外币编码
        SsCode = ""
        BankBillNo = ""
        CustName = Trim(.Fields("CusName") & "")                     '客户名称
        SupplierName = ""
    End With
    
    Select Case VouchModel
        Case "9"     '借应收，贷应交税金，贷销售收入
            
            '写借应收帐款分录
            VouchRow = VouchRow + 1
            YbJe = YbYsje
            BbJe = BbYsje
            AccCode = AccCodeArAp
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
                        
            '贷销售收入
            With RecInvoice
                Do While .EOF = False
                    VouchRow = VouchRow + 1
                    If IsPriceTaxSep = True Then                        '价税分开
                        YbJe = Val(Trim(.Fields("invoiceMoney") & ""))  '无税原币收入金额
                        BbJe = Val(Trim(.Fields("CapitalMoney") & ""))  '无税本币收入金额
                    Else
                        YbJe = Val(Trim(.Fields("WholeMoney") & ""))    '含税原币收入金额
                        BbJe = Val(Trim(.Fields("WholeMoney") & ""))    '含税本币收入金额
                    End If
                    Sl = Val(Trim(.Fields("Quantity")) & "")            '销售数量
                    AccCode = Trim(.Fields("SellAccCode") & "")         '销售收入科目
                    Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
                    
                    '贷销售税金
                    If IsPriceTaxSep = True Then                          '价税分离
                        VouchRow = VouchRow + 1
                        YbJe = Val(Trim(.Fields("TaxMoney") & ""))        '税原币金额
                        BbJe = Val(Trim(.Fields("CapitalTax") & ""))      '税本币金额
                        AccCode = Trim(.Fields("SellTaxAccCode") & "")    '销项税金科目
                        Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
                    End If
                    .MoveNext
                Loop
            End With
'        Case "" '另一种凭证模式
        
    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("QuantityFlag") = True Then

                If str_TranOri = "贷" Then                           '数量
                    .Fields("Jfsl") = Sl
                Else
                    .Fields("Dfsl") = Sl
                End If
            End If
            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                                        '生成凭证日期
    Call FillImageCombo(Imagbo_Vouch, "cwzz_AccVouchClass", 1)    '填充凭证类别列表


    '定义凭证的模板类型，和搜索需要生成凭证的记录的条件
    SqlStr = "SELECT * FROM RP_TranVouch WHERE " & MenuBillCode_Con
    Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If rectemp.EOF = False Then
        For i = 1 To Imagbo_Vouch.ComboItems.Count
            If Trim(Mid(Imagbo_Vouch.ComboItems(i).Key, 2, Len(Imagbo_Vouch.ComboItems(i).Key))) = Trim(rectemp.Fields("VouchClassCode")) Then
                Imagbo_Vouch.ComboItems.Item(i).Selected = True
            End If
        Next i
    End If
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 & "'")
                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 & "'")
                    Rec_VouchMain.MoveNext
                Loop
        End Select
    End If
End Sub
Private Sub Clean()               '删除临时数据表数据
    If Bln_DeleteFlag = True Then
        '删除临时凭证主从表
        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 If
End Sub