📄
字号:
If PriceMode = "计划价法" Then
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False, "plan"
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 '临时使用查询字符串
Dim tempResult As Double
Dim dblNowQuan As Double
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 tempQuan = 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" '货区
If .TextMatrix(Dqpdwgh, 0) = "*" And Trim(Str_JudgeText) <> "" Then
If Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then
Tsxx = "请先输入物料!"
Dqpdwgl = Sydz("001", GridStr(), Szzls)
GoTo Lrcwcl
End If
'1.放置字段有效性判断
If Trim(Str_JudgeText) <> "" Then
If CheckArea(LrText(1).Tag, Trim(Str_JudgeText), AreaCode, AreaName) = True Then
Tsxx = "此货区不存在或不属于本仓库或不是末级货区!"
Dqpdwgl = Sydz("005", G
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -