VB开发的ERP系统

                End If
            End If
            
            '字段不能为零
            If GridInt(Jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next Jsqte
        
        '1.2进行其他有效性判断,编写格式同1.1
            
        '2.放置行处理程序(当数据行通过有效性判断)

        '以上为自定义部分<<]
    End With

    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Lrcwcl:      '录入错误处理
    With WglrGrid
  
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
      
        '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
    
        '函数返回False
        Sjhzyxxpd = False
        Exit Function
    End With

End Function

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim Rectemp As New ADODB.Recordset            '临时使用动态集
    Dim Jsqte As Long                             '临时计数器
   
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
       Exit Sub
    End If
    
    '系统操作日期不在当前会计年度
    If Not Xtyear = PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    '系统操作日期是否在当前会计期间
    If Not Xtmm = PGNowmon Then
        Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    '设置操作状态为浏览，选择仓库后状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
       
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
   
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
      
    '录入文本框清除内容
    For Jsqte = Max_Text_Index To 0 Step -1
        LrText(Jsqte).Tag = ""
        LrText(Jsqte).Text = ""
    Next Jsqte
   
    '[>>显示制单人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(8).Text = ""
    LrText(9).Text = Xtczy
            
    LrText(0).Enabled = False
    
    '设置单据日期默认为系统业务日期
    TextChangeLock = True
    LrText(1).Text = Format(Xtrq, "yyyy-mm-dd")
    TextChangeLock = False
   
    '<<]
   
    '重置网格(Fixed)
    With WglrGrid
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
        For Jsqte = .FixedRows To .Rows - 1
            .RowHeight(Jsqte) = Sjhgd
        Next Jsqte
        WglrGrid.Clear 1
        Changelock = True
        .Select .FixedRows, Qslz
        Changelock = False
    End With
   
    '计算合计数据(清零)(Fixed)
    For Jsqte = Qslz To WglrGrid.Cols - 1
        Call Sjhj(Jsqte)
    Next Jsqte
    
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    LrText(1).SetFocus
    
End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
 
    Dim Jsqte As Long                    '临时使用计数器
  
    '先关闭录入载体(Fixed)
    Changelock = True
    Valilock = True
    Call Ycwbk
    Changelock = False
    Valilock = False

    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("InOutAdjustMainId")
        Call Sub_ShowBill
    Else
        '单据ID置为0
        Lab_BillId.Caption = 0
     
        '清除录入文本框
        For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Tag = ""
            LrText(Jsqte).Text = ""
        Next Jsqte

        '重置网格(Fixed)
        With WglrGrid
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte

            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With

        '计算合计数据(清零)(Fixed)
        For Jsqte = Qslz To WglrGrid.Cols - 1
            Call Sjhj(Jsqte)
        Next Jsqte
    End If
    
    '设置操作状态为浏览
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    
End Sub

Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
  
    Dim Rectemp As New ADODB.Recordset                    '临时使用动态集
    Dim RecTempFz As New ADODB.Recordset                  '临时使用动态集
    Dim RectempMx As New ADODB.Recordset                  '临时使用动态集
    Dim RecTempZz As New ADODB.Recordset                  '临时使用动态集
    Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
    Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
    Dim Rowjsq As Long                                    '网格行计数器
    Dim Coljsq As Long                                    '网格列计数器
    Dim Jsqte As Integer                                  '临时计数器
    Dim Lng_RowCount As Long                              '有效数据行计数器
    Dim Lrywlz As Long                                    '录入有误列值
    Dim SqlStr As String                                  'SQL语句
    Dim DiffE As Double                                   '差异额
    Dim mPeriod As Integer                                '当前会计期间
  
    Sub_SaveBill = False
  
    '一.============先对单据内容进行有效性判断==============='
  
    '先进行字段不能为空或不能为零有效性判断(Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 8) = 1 Then     '字段不能为空
            If Len(Trim(LrText(Jsqte).Text)) = 0 Then
                Tsxx = Textstr(Jsqte, 7) & "不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Jsqte).SetFocus
                Exit Function
            End If
        Else
            If Textint(Jsqte, 8) = 2 Then   '字段不能为零
                If Val(Trim(LrText(Jsqte).Text)) = 0 Then
                    Tsxx = Textstr(Jsqte, 7) & "不能为零!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(Jsqte).SetFocus
                    Exit Function
                End If
            End If
        End If
    Next Jsqte
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
            If Not TextYxxpd(Jsqte) Then
                Call TextShow(Jsqte)
                Exit Function
            End If
        End If
    Next Jsqte
  
    '[>>
  
    '可在此区域写入其他对单据表头内容的有效性判断.
    
    '单据录入日期是否在当前年度
    If Not Year(CDate(LrText(1))) = PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
    
    mPeriod = PGNowmon
    
    '单据日期必须在当前会计期间
    If Month(LrText(1).Text) <> mPeriod Then
        Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(mPeriod)) + ")之内!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If

    '<<]
  
    '[>>下面将对所有有效数据行进行有效性判断
  
    Lng_RowCount = 0
  
    With WglrGrid
        For Rowjsq = .FixedRows To .Rows - 1
            '带*号者为有效数据行(Fixed)
            If .TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            Else
                Lng_RowCount = Lng_RowCount + 1
            End If
            '1.首先进行为空或为零判断(Fixed)

            For Jsqte = Qslz To .Cols - 1
            
                '字段不能为空
                If GridInt(Jsqte, 5) = 1 Then
                    If Len(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
                        Tsxx = GridStr(Jsqte, 2)
                        Lrywlz = Jsqte
                        GoTo Lrcwcl
                        Exit For
                    End If
                End If
                
                '字段不能为零
                If GridInt(Jsqte, 5) = 2 Then
                    If Val(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
                        Tsxx = GridStr(Jsqte, 2)
                        Lrywlz = Jsqte
                        GoTo Lrcwcl
                        Exit For
                    End If
                End If
            Next Jsqte
           
            '2.判断存货编码是否存在(Define)
            SqlStr = "SELECT MNumber From Gy_Material Where MNumber='" & Trim(.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            If Rectemp.EOF Then
                Tsxx = "此存货编码不存在!"
                Lrywlz = Sydz("001", GridStr(), Szzls)
                GoTo Lrcwcl
            End If
        Next Rowjsq
     
        '单据分录行数不能为零(Fixed)
        If Lng_RowCount = 0 Then
            Tsxx = "单据分录行数不能为零!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
        
        '[>>
        '此处可以定义整张单据不能通过有效性检查的理由
        '<<]
    End With  '网格
   
   
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
   
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    
        '新增单据
        
        '1.对于某些单据号自动生成的单据则可在此处自动生成
         LrText(0).Text = CreatBillC