VB开发的ERP系统

            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("BillItemName") & "")            '票据类型
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("NoteCode") & "")                '单据编号
            CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")                 '客户名称
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")         '币别名称
            YbJe = Val(Trim(.Fields("YbCash") & ""))               '原币金额
            BbJe = Val(Trim(.Fields("BbCash") & ""))               '本币金额
            YbExpense = Val(Trim(.Fields("YbExpense") & ""))       '原币费用
            BbExpense = Val(Trim(.Fields("BbExpense") & ""))       '本币费用
            CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = YbJe
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = BbJe
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")                  '部门名称
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")                '经办人
            CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("Digest") & "")                    '摘要
            If Trim(.Fields("VouchNo") & "") = "" Or Trim(.Fields("IfBuildVouch") & "") = False Then                    '凭证类别和凭证号
                CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = ""
            Else
                CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("VouchClassCode") & "") & "-" & Trim(.Fields("VouchNo") & "")
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("018", GridStr(), Szzls)) = Trim(.Fields("TranVouchClassCode") & "")

            
            '<<]
            
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
            
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
        Loop
        Jsq_Max = jsqte - 1
    End With
    
    ']以上为用户自定义部分

End Sub
Private Function Tran_Pd() As Boolean            '转帐之前的判断
    Dim jsq As Long             '临时计数器
    
    Tran_Pd = False
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Function
    End If
    
    '会计期间
    '判断用户所选业务日期与当前会计期间是否一致
    Sqlstr = "Select Top 1 * FROM Gy_Kjrlb Where ArJzbz=0 Order By Kjyear,Period"

    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    With RecTemp
        If Not .EOF Then
            If Not (Xtrq >= .Fields("Qsrq") And Xtrq <= .Fields("Zzrq")) Then
                Tsxx = "业务日期应在当前会计期间范围内!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            Else
                Int_Kjyear = .Fields("Kjyear")
                Int_Period = .Fields("Period")
            End If
        Else
            Tsxx = "业务日期会计期间已结帐完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    End With
    
    
    '将每个转帐过程编号赋值到FiltListId（）数组中，
    ReDim FiltListId(1)         '变动单ID
    ReDim TranVouchClass(1)     '将每个转帐过程的凭证类别放到数组TranVouchClass中
    ReDim VouchModelType(1)     '凭证模板
    ReDim TranNoteCode(1)       '应收票据编码
    TranJsq = 0
        
    '将需要制作凭证的记录的AccListId保存到FiltListId中。
    '将产生的凭证张数，保存在TranJsq中。
    
    For jsq = CxbbGrid.FixedRows To Jsq_Max
        If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) <> "" Then
            If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "1" Then   '若生成的凭证需要合并
                UnitFlag = True
            Else
                UnitFlag = False
            End If
            If TranJsq = 0 Then
                
                TranJsq = TranJsq + 1
            Else
                If TranJsq > 1 Then
                    ReDim Preserve TranVouchClass(UBound(TranVouchClass) + 1)
                    ReDim Preserve FiltListId(UBound(FiltListId) + 1)
                    ReDim Preserve VouchModelType(UBound(VouchModelType) + 1)
                    ReDim Preserve TranNoteCode(UBound(TranNoteCode) + 1)
                    
                End If
            End If
            FiltListId(TranJsq) = CxbbGrid.TextMatrix(jsq, 0)                                 '变动单ID
            TranVouchClass(TranJsq) = CxbbGrid.TextMatrix(jsq, Sydz("018", GridStr(), Szzls)) '凭证类别编码
            VouchModelType(TranJsq) = CxbbGrid.TextMatrix(jsq, 4)                             '凭证模板类型
            TranNoteCode(TranJsq) = CxbbGrid.TextMatrix(jsq, Sydz("005", GridStr(), Szzls))   '应收票据编码
            
            TranJsq = TranJsq + 1
        End If
    Next jsq
    
    '本次需要制作凭证的有效记录个数
    TranJsq = TranJsq - 1
    If TranJsq <= 0 Then
        Tsxx = "请选择单据!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
   
    OperationNum = CreatBillID("0102")                     '本次制作凭证的操作批号
    Tran_Pd = True
End Function

Private Sub Sub_Run() '生成凭证
    Dim jsq As Long                      '临时计数器
    Dim lng_OperationNum As Long            '临时凭证ID

    Bln_DeleteFlag = True
    
    '判断有效性
    If Tran_Pd = False Then
        Exit Sub
    End If
    
   '【写临时凭证
    On Error GoTo ERR1
    Cw_DataEnvi.DataConnect.BeginTrans
    Select Case UnitFlag
        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.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 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 YbPmInterest As Double              '原币票面利息
    Dim BbPmInterest As Double              '本币票面利息
    Dim YbPmJe As Double                    '原币票面金额
    Dim BbPmJe As Double                    '本币票面金额
    
    Dim YbExpense As Double                 '原币变动费用
    Dim BbExpense As Double                 '本币变动费用
    Dim YbCash As Double                    '原币变动金额
    Dim BbCash As Double                    '本币变动金额
    
    Sqlstr = "SELECT * FROM Ar_v_NoteClose WHERE NoteCloseId='" & AccList_Id & "' and RPFLAG='AR'"
    Set RecNoteChange = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    Sqlstr = "SELECT * FROM RP_Note WHERE NoteCode='" & TranNoteCode & "' and RPFLAG='AR' "
    Set RecNote = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '应收票据票面数据
    With RecNote
        YbPmInterest = Val(Trim(.Fields("YbInTerest") & ""))           '原币票面利息
        BbPmInterest = Val(Trim(.Fields("BbInTerest") & ""))           '本币票面利息
        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") & "")                        '应收票据科目
        AccCodeInterest = Trim(.Fields("AccCodeInterest") & "")      '利息科目编码
        AccCodeExpense = Trim(.Fields("AccCodeExpense") & "")        '费用科目编码
        DeptCode = Trim(.Fields("DeptCode") & "")                    '部门
        PersonCode = Trim(.Fields("PersonCode") & "")                '经办人编码
        CusCode = Trim(.Fields("PsCode") & "")                       '客户
        SupplierCode = Trim(.Fields("EndorseCusCode") & "")          '供应商
        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") & ""))                   '本币变动金额
        YbExpense = Val(Trim(.Fields("YbExpense") & ""))             '原币变动费用
        BbExpense = Val(Trim(.Fields("YbExpense") & ""))             '本币变动费用
        Select Case Trim(.Fields("BillItemCode") & "")
            Case "43"       '背书
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = Trim(.Fields("SupplierName") & "")        '供应商名称
            Case "41"       '转出
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = ""
            Case Else
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = ""
        End Select
    End With