📄 +
字号:
Else
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False, "default"
End If
End If
Case "dy" '打 印
If Fun_Drfrmyxxpd Then
Dim Yhanswer As Integer '打印提示
'用户确认是否打印单据
Tsxx = "请确认是否打印当前单据?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 2 Then
Exit Sub
End If
If PriceMode = "计划价法" Then
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True, "plan"
Else
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True, "default"
End If
End If
Case "xz" '新 增
Call Sub_AddBill
Case "xg" '修 改
Call Sub_EditBill
Case "sc" '删 除
Call Sub_DeleteBill
Case "zh" '增 行
Call zjlrfl
Case "sh" '删 行
Call Scdqfl
Case "bc" '保 存
If Fun_Drfrmyxxpd Then
Call Sub_SaveBill
End If
Case "fq" '放 弃
Call Sub_AbandonBill
Case "shsh" '审 核
Call Sub_CheckBill
Case "shqs" '弃 审
Call Sub_AbandonCheck
Case "first" '首 张
Call Sub_First
Case "prev" '上 张
Call Sub_Prev
Case "next" '下 张
Call Sub_next
Case "last" '末 张
Call Sub_Last
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
'解 锁
Valilock = False
Changelock = False
TextChangeLock = False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
Select Case KeyCode
Case vbKeyF5 '增加单据
If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
Call Sub_AddBill
End If
Case vbKeyF3 '修改单据
If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
Call Sub_EditBill
End If
Case vbKeyF6 '保存单据
If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
If Fun_Drfrmyxxpd Then Call Sub_SaveBill
End If
End Select
End Sub
Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With Tlb_Action
Select Case Str_Status
Case "10" '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
.Buttons("xz").Enabled = True '新增
.Buttons("xg").Enabled = True '修改
.Buttons("sc").Enabled = True '删除
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("first").Enabled = True '首张
.Buttons("prev").Enabled = True '上张
.Buttons("next").Enabled = True '下张
.Buttons("last").Enabled = True '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置审核弃审按钮状态
Call Sub_CheckStatus
'设置文本框录入状态
Call Sub_LrtextStatus(False)
Case "20" '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.Buttons("first").Enabled = False '首张
.Buttons("prev").Enabled = False '上张
.Buttons("next").Enabled = False '下张
.Buttons("last").Enabled = False '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
Case "30" '修改(（录入）调入修改功能、（列表）调入修改功能)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.Buttons("first").Enabled = False '首张
.Buttons("prev").Enabled = False '上张
.Buttons("next").Enabled = False '下张
.Buttons("last").Enabled = False '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
End Select
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
OptRed.Enabled = False
OptBlue.Enabled = False
End If
End Sub
Private Sub Sub_CheckStatus() '设置审核弃审按钮状态(亦可设置其它动作按钮状态)
'根据当前单据状态来确定审核弃审按钮状态
If Trim(LrText(9).Text) <> "" And Trim(LrText(10).Text) = "" Then
Tlb_Action.Buttons("shsh").Enabled = True '审核
Else
Tlb_Action.Buttons("shsh").Enabled = False '审核
End If
If Trim(LrText(9).Text) <> "" And Trim(LrText(10).Text) <> "" Then
Tlb_Action.Buttons("shqs").Enabled = True '弃审
Else
Tlb_Action.Buttons("shqs").Enabled = False '弃审
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 "001" '物料编码
If Not Trim(Str_JudgeText) = "" Then
'1.放置字段有效性判断
Sqlstr = "SELECT MNumber,MName,Model,PrimaryUnitName,Ispcgl,Isbzqgl,PlanPrice From Gy_Material Where MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If RecTemp.EOF Then
Tsxx = "此物料编码不存在!"
GoTo Lrcwcl
End If
'2.放置字段事后处理程序
.TextMatrix(Dqpdwgh, 2) = RecTemp.Fields("Ispcgl")
.TextMatrix(Dqpdwgh, 3) = RecTemp.Fields("Isbzqgl")
.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "") '显示物料编码
.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "") '显示物料名称
.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "") '显示物料规格型号
.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("PrimaryUnitName") & "") '计量单位
.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = Val(RecTemp.Fields("PlanPrice")) '计划价
If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) <> "" Then
.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls)) = Format(Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls))) * Val(RecTemp.Fields("PlanPrice")), "##0." + String(Xtjexsws, "0"))
End If
Else
'3.清空相关字段
.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = "" '物料名称
.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = "" '物料规格型号
.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = "" '物料规格型号
End If
'如果对应物料不使用批此管理,则设为空值
If conBatch = 1 Then
If Trim(.TextMatrix(Dqpdwgh, 2)) <> "" Then
If CBool(.TextMatrix(Dqpdwgh, 2)) = False Then
.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""
End If
End If
End If
If conQuan = 1 Then
If Trim(.TextMatrix(Dqpdwgh, 3)) <> "" Then
If CBool(.TextMatrix(Dqpdwgh, 3)) = False Then
.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
End If
End If
End If
Case "005" '货区
'1.放置字段有效性判断
If Trim(Str_JudgeText) <> "" Then
If CheckArea(LrText(1).Tag, Trim(Str_JudgeText), AreaCode, AreaName) = True Then
Tsxx = "此货区不存在或不属于本仓库或不是末级货区!"
Dqpdwgl = Sydz("005", GridStr(), Szzls)
GoTo Lrcwcl
End If
.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(AreaName & "")
.TextMatrix(Dqpdwgh, 1) = Trim(AreaCode & "")
End If
'2.放置字段事后处理程序
Case "006" '批次管理
'如果对应物料不使用批此管理,则设为⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -