⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 +

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
    End With

End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态

    '录入文本框状态设置
    If TextEnabled Then
        For jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(jsqte, 5) Then
                LrText(jsqte).Enabled = True
            Else
                LrText(jsqte).Enabled = False
            End If
        Next jsqte
    Else
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Enabled = False
        Next jsqte
    End If

End Sub




Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        If GridBoolean(.Col, 3) Then   '列表框录入
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
       
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
         
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With

End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
 
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值

    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串

    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
      
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分

            Case "006"          '需求数量
                '1.放置字段有效性判断
                If Str_JudgeText <> "" Then
                    If Not IsNumeric(Str_JudgeText) Then
                        Tsxx = "非法数字录入!"
                        GoTo Lrcwcl
                    ElseIf Val(Str_JudgeText) <= 0 Then
                        Tsxx = "需求数量不能小于等于零!"
                        GoTo Lrcwcl
                        
                    End If
                Else
                    If Len(Str_JudgeText) = 0 Then
                        Tsxx = "需求数量不能为空!"
                        GoTo Lrcwcl
                    End If
                End If
                '2.放置字段事后处理程序

                '2.放置字段事后处理程序
 
                '<<以上为自定义部分]
        End Select
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
     
        '字段录入正确后进行数据合计(Fixed)
        For Coljsq = Qslz To .Cols - 1
            Call Sjhj(Coljsq)
        Next Coljsq
     
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
  
Lrcwcl:    '录入错误处理
    With WglrGrid
  
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
          
        '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
          
        '函数返回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)         '判断网格列对应逻辑编号
               
            '[>>以下为自定义部分
            '<<以上为自定义部分]
        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            '临时使用动态集
    
    With WglrGrid
        '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
        If .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
        If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)) & "")) = 0 Then
            Tsxx = "需求数量不能为空!"
            Lrywlz = Sydz("007", GridStr(), Szzls)
            GoTo Lrcwcl
        End If
        If Trim(LrText(8)) = "正常" Then
            If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)) & "")) <= 0 Then
                Tsxx = "需求数量不能小于等于零!"
                Lrywlz = Sydz("007", GridStr(), Szzls)
                GoTo Lrcwcl
            End If
        End If

        '2.放置行处理程序(当数据行通过有效性判断)
        
        '以上为自定义部分<<]
    End With    'WglrGrid

    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    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                             '临时计数器
   
    On Error Resume Next
    
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
       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
   
    '[>>
    '设置可以修改的文本框
    For jsqte = 0 To Max_Text_Index
        LrText(jsqte).Enabled = True
        LrText(jsqte).Text = ""
        LrText(jsqte).Tag = ""
    Next jsqte
    LrText(2).Enabled = False
    LrText(3).Enabled = False
    LrText(4).Enabled = False
    LrText(5).Enabled = False
    LrText(6).Enabled = False
    LrText(9).Enabled = False
    
    '显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(9).Text = Xtczy
    LrText(6).Text = "未审核"
    LrText(8).Text = 100
       
    '读取最新的单据编码
 
       
    '设置订单日期默认为系统业务日期
    TextChangeLock = True
    LrText(5).Text = Xtrq
    TextChangeLock = False
    '<<]
   
    '重置网格(Fixed)
    With WglrGri

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -