📄 +
字号:
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 + -