📄
字号:
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Dim Sqlstr As String '查询单据列表条件
'[>>根据实际情况初始化
Select Case Str_Pzclzt
Case "1" '填制单据
'调入用户查询结果动态集
Sqlstr = "SELECT PurPlanMainId From Cg_PurPlanMain Where PurPlanDate='" & Xtrq & "' and PurPlanStyle>0 and SplitUniteFlag=0 ORDER BY PurPlanMainId"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
'新增单据
Call Sub_AddBill
Case "2" '查询单据(单据列表)
'填充查询单据标识
Lab_BillId.Caption = XT_BillID
Str_QueryCondi = Xtcdcsfz
Call Sub_ShowBill
Call Sub_OperStatus("10")
'调入用户查询结果动态集
Sqlstr = "SELECT DISTINCT PurPlanMainId From Cg_V_PlanBill a " & Str_QueryCondi & " ORDER BY PurPlanMainId"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "PurPlanMainId=" & S2N(Lab_BillId.Caption)
Case "3" '合并拆分时查看单据
'设置工具条显示
'调入用户查询结果动态集
Lab_BillId.Caption = XT_BillID
Str_QueryCondi = Xtcdcsfz
Sqlstr = "SELECT DISTINCT PurPlanMainId From Cg_V_PlanBill a " & Str_QueryCondi & " ORDER BY PurPlanMainId"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "PurPlanMainId=" & S2N(Lab_BillId.Caption)
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
With Tlb_Action
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.Buttons("exec").Enabled = False '下达
.Buttons("close").Enabled = False '关闭
.Buttons("first").Enabled = True '首张
.Buttons("prev").Enabled = True '上张
.Buttons("next").Enabled = True '下张
.Buttons("last").Enabled = True '末张
End With
'录入文本框
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Enabled = False
Next jsqte
Case "4" '查看生产需求计划
'设置工具条显示
'调入用户查询结果动态集
Lab_BillId.Caption = XT_BillID
Str_QueryCondi = Xtcdcsfz
Sqlstr = "SELECT DISTINCT PurPlanMainId From Cg_V_FullPlanBill a " & Str_QueryCondi & " ORDER BY PurPlanMainId"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "PurPlanMainId=" & S2N(Lab_BillId.Caption)
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
With Tlb_Action
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.Buttons("exec").Enabled = False '下达
.Buttons("close").Enabled = False '关闭
.Buttons("first").Enabled = True '首张
.Buttons("prev").Enabled = True '上张
.Buttons("next").Enabled = True '下张
.Buttons("last").Enabled = True '末张
End With
'录入文本框
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Enabled = False
Next jsqte
End Select
'<<]
End Sub
Private Sub Sub_ShowBill() '根据当前单据ID显示整张单据内容
'过程默认参数为当前窗体中单据ID:Lab_BillID
Dim Sqlstr As String '临时使用字符串
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim jsqte As Long '临时计数器
'禁止网格刷新动作,为加快网格显示速度(Fixed)
WglrGrid.Redraw = False
'本张单据查询字符串
Sqlstr = "SELECT * From Cg_V_FullPlanBill" & _
" Where PurPlanMainId='" & S2N(Lab_BillId.Caption) & "' Order By Cg_V_FullPlanBill.PurPlanSubId"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
WglrGrid.Rows = WglrGrid.FixedRows
If .EOF Then
WglrGrid.Redraw = True
Exit Sub
Else
'[>>显示单据头
TextChangeLock = True '文本框加锁
LrText(0).Text = Trim(.Fields("KjYear")) '会计年
LrText(1).Text = Trim(.Fields("Period")) '会计月份
LrText(2).Text = Trim(.Fields("PurPlanNum")) '计划单号
LrText(3).Text = Format(Trim(.Fields("PurPlanDate")), "yyyy-mm-dd") '计划日期
LrText(4).Text = Trim(.Fields("PurPlanType") & "") '计划类型
LrText(5).Tag = Trim(.Fields("DeptCode") & "") '部门编码
LrText(5).Text = Trim(.Fields("DeptName") & "") '部门名称
LrText(6).Tag = Trim(.Fields("PersonCode") & "") '计划人编码
LrText(6).Text = Trim(.Fields("PersonName") & "") '计划人名称
LrText(7).Tag = Trim(.Fields("SupplierCode") & "") '供应商编码
LrText(7).Text = Trim(.Fields("SupplierName") & "") '供应商名称
LrText(8).Text = Trim(.Fields("Remark") & "") '备注
LrText(9).Text = Trim(.Fields("Maker") & "") '制单人
LrText(10).Text = Trim(.Fields("Checker") & "") '审核人
LrText(11).Text = Trim(.Fields("Transmitter") & "") '下达人
TextChangeLock = False '文本框解锁
'<<]
Chk_JJPlan.Value = .Fields("ExigenceFlag")
If Chk_JJPlan.Value Then
LrText(12).Text = "紧急计划"
Else
LrText(12).Text = "正常计划"
End If
If Trim(LrText(11).Text) <> "" Then
Tlb_Action.Buttons("exec").Value = tbrPressed
Tlb_Action.Buttons("exec").Caption = "收回"
Tlb_Action.Buttons("exec").Image = "shh"
Else
Tlb_Action.Buttons("exec").Value = tbrUnpressed
Tlb_Action.Buttons("exec").Caption = "下达"
Tlb_Action.Buttons("exec").Image = "xd"
End If
If .Fields("FinishFlag") Then
Tlb_Action.Buttons("close").Value = tbrPressed
Tlb_Action.Buttons("close").Caption = "恢复"
Tlb_Action.Buttons("close").Image = "hf"
Else
Tlb_Action.Buttons("close").Value = tbrUnpressed
Tlb_Action.Buttons("close").Caption = "关闭"
Tlb_Action.Buttons("close").Image = "gb"
End If
Chk_JJPlan.Enabled = False
End If
jsqte = WglrGrid.FixedRows
Do While Not .EOF
WglrGrid.AddItem ""
'[>>显示单据分录
WglrGrid.TextMatrix(jsqte, 0) = "*" '数据有效行标识(必填)
WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "") '物料编码
WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "") '物料名称
WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "") '物料规格
WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PurUnitName") & "") '计量单位
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = .Fields("Quantity") '数量
WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Format(Trim(.Fields("PlanArriveDate") & ""), "yyyy-mm-dd") '到货日期
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("ProcFactory") & "" '生产厂家
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("SubRemark") & "" '备注
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("BuyerName") & "" '采购员
'<<]
WglrGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
'调整网格(Fixed)
Call Sub_AdjustGrid
'计算合计数据(Fixed)
For jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(jsqte)
Next jsqte
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
'设置审核弃审按钮状态
If Xtcdcs <> "3" And Xtcdcs <> "4" Then
Call Sub_CheckStatus
End If
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
Changelock = True
Select Case Button.Key
Case "yl" '预 览
If Fun_Drfrmyxxpd Then
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
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
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
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
Case "exec"
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightExec, Xtczybm, 1, True) Then
Exit Sub
End If
If Tlb_Action.Buttons("exec").Value = tbrPressed Then
If Sub_ExecPlanBill() Then
Tlb_Action.Buttons("exec").Caption = "收回"
Tlb_Action.Buttons("exec").Image = "shh"
Sub_CheckStatus
Else
Tlb_Action.Buttons("exec").Value = tbrUnpressed
End If
Else
If Sub_UnExecPlan() Then
Tlb_Action.Buttons("exec").Caption = "下达"
Tlb_Action.Buttons("exec").Image = "xd"
Sub_CheckStatus
Else
Tlb_Action.Buttons("exec").Value = tbrPressed
End If
End If
Case "close"
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -