VB开发的ERP系统

        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With

End Function

Private Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long)       '当网格列值发生改变时,处理网格列之间的关联计算(可选)
  
  '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
   
    With WglrGrid
        Select Case GridStr(Lng_CountCol, 1)         '判断网格列对应逻辑编号
               
            '[>>以下为自定义部分
            Case Else
            '<<以上为自定义部分]
        End Select
    End With

End Sub

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
 
    '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值

    Dim Lrywlz As Long                            '录入有误网格列值
    Dim Rectemp As New ADODB.Recordset            '临时使用动态集
    Dim SqlStr As String
    
    With WglrGrid
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                '当要判断行处于网格末行时才允许删行,否则要进行有效性判断
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    Changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                        .AddItem ""
                        .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    Changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        End If
  
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
  
        '[>>以下为自定义部分
    
        '1.放置行有效性判断程序
           
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For Jsqte = Qslz To .Cols - 1
            
            '字段不能为空
            If GridInt(Jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, 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(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.放置行处理程序(当数据行通过有效性判断)
        
        For Jsqte = .FixedRows To .Rows - 1
            If .TextMatrix(Jsqte, 0) = "*" Then
                If Trim(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) = "" And Trim(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) <> "" Then
                    Tsxx = "被调整单据名称不能为空!"
                    Lrywlz = Sydz("005", GridStr(), Szzls)
                    GoTo Lrcwcl
                    Exit For
                ElseIf Trim(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) <> "" And Trim(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) = "" Then
                    Tsxx = "被调整单据号不能为空!"
                    Lrywlz = Sydz("006", GridStr(), Szzls)
                    GoTo Lrcwcl
                    Exit For
                ElseIf Trim(.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls))) <> "" And Trim(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) <> "" Then
                    SqlStr = "select inoutmainid,inoutsubid,chalkitupman from chhs_v_inout " & _
                            " where billcode='" & Trim(.TextMatrix(Jsqte, 1)) & "' " & _
                            " and billnum='" & Trim(.TextMatrix(Jsqte, Sydz("006", GridStr, Szzls))) & "'" & _
                            " and mnumber='" & Trim(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls))) & "'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Rectemp.EOF Then
                        Tsxx = "单据名称+单据号+存货编码不匹配!"
                        Lrywlz = Sydz("006", GridStr(), Szzls)
                        GoTo Lrcwcl
                        Exit For
                    Else
                        If Trim(Rectemp.Fields("chalkitupman") & "") = "" Then
                            Tsxx = "单据未记帐，不允许调整!"
                            Lrywlz = Sydz("006", GridStr(), Szzls)
                            GoTo Lrcwcl
                            Exit For
                        Else
                            .TextMatrix(Jsqte, 2) = Rectemp.Fields("inoutmainid")
                            .TextMatrix(Jsqte, 3) = Rectemp.Fields("inoutsubid")
                        End If
                    End If
                End If
            End If
        Next

        '以上为自定义部分<<]
    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                                '当前会计期间
    Dim SumQuan As Double                                 '数量
    Dim SumMoney As Double                                '金额
    Dim MoveMoney As Double                               '移动平均单价
    
    Sub_SaveBill = False
  
    '一.============先对单据内容进行有效性判断==============='
  
    '先进行字段不能为空或不能为零有效性判断(Fixed)
    For Jsqte = 0 To Max_Text