📄
字号:
With WglrGrid
Select Case GridStr(Lng_CountCol, 1) '判断网格列对应逻辑编号
'[>>以下为自定义部分
Case "004" '单重改变
'计算公式:单重*数量=总重
If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtslxsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = ""
End If
Case "005" '单价改变
'计算公式:单价*数量=金额
If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "##0." + String(Xtjexsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = ""
End If
Case "006" '数量改变
'计算公式:单重*数量=总重
If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtslxsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = ""
End If
'计算公式:单价*数量=金额
If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtjexsws, "0"))
Else
.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = ""
End If
Case "008" '金额改变
'计算公式:金额/数量=单价
If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
If Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtdjxsws, "0"))
End If
End If
'<<以上为自定义部分]
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
'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 '临时计数器
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
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
'[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
LrText(10).Text = Xtczy
LrText(11).Text = ""
'读取最新的单据编码
LrText(1).Text = CreatBillCode(BillCode, False)
'设置订单日期默认为系统业务日期
TextChangeLock = True
LrText(0).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_EditBill() '修改一张单据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'非有效单据不予进行修改动作
If Val(Lab_BillId.Caption) = 0 Then
Exit Sub
End If
'判断当前单据是否允许修改
If Not Fun_AllowEdit Then
Exit Sub
End If
'设置操作状态为修改
Lab_OperStatus.Caption = "3"
'设置工具条状态
Call Sub_OperStatus("30")
'显示制单人
LrText(10).Text = Xtczy
End Sub
Private Sub Sub_DeleteBill() '删除当前单据
Dim YAnswer As Integer '确认是否删除当前单据
Dim jsqte As Long '临时使用计数器
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'非有效单据不予进行删除动作
If Val(Lab_BillId.Caption) = 0 Then
Exit Sub
End If
Tsxx = "请确认是否删除当前单据?"
YAnswer = Xtxxts(Tsxx, 2, 2)
If YAnswer = 1 Then
'判断当前单据是否允许删除
If Not Fun_AllowEdit Then
Exit Sub
End If
'进行事务处理
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
'1.删除单据所有内容
Cw_DataEnvi.DataConnect.Execute ("Delete Tr_ApplySub Where ApplyMainId=" & Val(Lab_BillId.Caption))
Cw_DataEnvi.DataConnect.Execute ("Delete Tr_ApplyMain Where ApplyMainId=" & Val(Lab_BillId.Caption))
Cw_DataEnvi.DataConnect.CommitTrans
'标识单据发生改动
Bln_BillChange = True
'单据ID置0
Lab_BillId.Caption = 0
Else
Exit Sub
End If
'删除单据后重置状态
'1.显示下一张单据
Call Sub_Next
'2.如果无下一张单据则搜索上一张单据
If Val(Lab_BillId.Caption) = 0 Then
Call Sub_Prev
End If
'3.如无单据则置单据为空状态
If Val(Lab_BillId.Caption) = 0 Then
'清除录入文本框
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
'设置操作状态为浏览
Lab_OperStatus = "1"
Call Sub_OperStatus("10")
End If
Rec_Query.Requery
Rec_Query.find "ApplyMainId=" & Val⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -