📄 包装物管理系统_业务处理_附属物出库单.frm
字号:
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 '临时使用查询字符串
Dim Temp_Int As Long
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 "001" '包装物编码
If Not Trim(Str_JudgeText) = "" Then
'1.放置字段有效性判断
Sqlstr = "SELECT * FROM Cask_V_AppertainHelp Where WrappageCode='" & Trim(LrText(3).Tag) & "' and AppertainCode='" & Str_JudgeText & "' Or WrappageName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If RecTemp.EOF Then
Tsxx = "此附属物编码不存在!"
GoTo Lrcwcl
End If
Temp_Int = 0
For i = .FixedRows To .Rows - 1
If .TextMatrix(i, Sydz("001", GridStr(), Szzls)) <> "" Then
If Trim(.TextMatrix(i, Sydz("001", GridStr(), Szzls))) = Str_JudgeText Then
Temp_Int = Temp_Int + 1
If Temp_Int > 1 Then
Tsxx = "此附属物编码已存在!"
GoTo Lrcwcl
End If
End If
End If
Next i
'2.放置字段事后处理程序
.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp!AppertainCode & "") '显示附属物编码
.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp!WrappageName & "") '显示附属物名称
.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp!UnitName & "") '显示计量单位
Else
'3.清空相关字段
.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = "" '附属物名称
.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = "" '附属物计量单位
End If
Case "004" '单价
'1.放置字段有效性判断
'2.放置字段事后处理程序
Call Sub_JoinCount(Dqpdwgh, Sydz("004", GridStr(), Szzls)) '单价(根据公式计算结果)
'3.金额字段有效性判断
Case "005" '数量
'1.放置字段有效性判断
'2.放置字段事后处理程序
Call Sub_JoinCount(Dqpdwgh, Sydz("005", GridStr(), Szzls)) '数量(根据公式计算结果)
'3.金额字段有效性判断
Case "006" '金额
'1.放置字段有效性判断
If Trim(Str_JudgeText) = "" Or Val(Str_JudgeText) = 0 Then
.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
End If
'2.放置字段事后处理程序
Call Sub_JoinCount(Dqpdwgh, Sydz("006", GridStr(), Szzls)) '金额(根据公式计算结果)
Case "007" '状态
If Not Trim(Str_JudgeText) = "" Then
Sqlstr = "SELECT * FROM Cask_Status Where StatusCode='" & Str_JudgeText & "' Or StatusName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If RecTemp.EOF Then
Tsxx = "此状态不存在!"
GoTo Lrcwcl
End If
'2.放置字段事后处理程序
.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = Trim(RecTemp!StatusName & "") '显示状态名称
End If
'<<以上为自定义部分]
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) '判断网格列对应逻辑编号
'[>>以下为自定义部分
Case "004" '单价改变
'计算公式:单价*数量=金额
If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "##0." + String(Xtjexsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
End If
Case "005" '数量改变
'计算公式:单价*数量=金额
If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
End If
Case "006" '金额改变
'计算公式:金额/数量=单价
If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
End If
End If
'<<以上为自定义部分]
End Select
End With
End Sub
Private Function Sjhzyxxpd(Yxxpdh As Long) As Boolean '录入数据行有效性判断,同时进行行处理
'函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
Dim Lrywlz As Long '录入有误网格列值
Dim RecTemp As New ADODB.Recordset '临时使用动态集
With WglrGrid
'判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
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.放置行处理程序(当数据行通过有效性判断)
'以上为自定义部分<<]
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
'设置操作状态为新增(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
'[>>显示制单人,清空审核人,此处还可以设置录入⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -