📄 c
字号:
End If
LrText(1).Text = Trim(!MNumber & "") '物料编码
LrText(2).Text = Trim(!MName & "") '物料名称
LrText(3).Text = Trim(!Model & "") '规格型号
LrText(4).Text = Trim(!PrimaryUnitName & "") '计量单位
LrText(5).Text = IIf(Val(!BatchNum & "") = 0, "", Val(!BatchNum & "")) '批号
LrText(6).Text = IIf(Val(!Quantity & "") = 0, "", Val(!Quantity & "")) '数量
LrText(12).Text = Trim(!productchecknum & "") '单据号
If IsDate(.Fields("PurReciptDate")) Then LrText(7).Text = Format(Trim(!PurReciptDate & ""), "yyyy-mm-dd") '生产日期
If IsDate(.Fields("StoCheckDate")) Then LrText(8).Text = Format(Trim(!StoCheckDate & ""), "yyyy-mm-dd") '检验日期
TsLabel(0).Tag = Trim(!GradeCode)
str_TempSql = "SELECT DISTINCT GradeCode,GradeName FROM QC_V_ProductStand where MNumber='" & Trim(LrText(1).Text & "") & "' order by GradeCode,GradeName"
Set rs_Temp1 = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
For i = 0 To Imgebo_Mnumber.ListCount - 1
Imgebo_Mnumber.RemoveItem 0
Next i
If Not rs_Temp1.EOF Then
For i = 0 To rs_Temp1.RecordCount - 1
Imgebo_Mnumber.AddItem Trim(rs_Temp1!gradename), i
rs_Temp1.MoveNext
Next i
End If
If Trim(!gradename & "") = "" Then
Imgebo_Mnumber.Clear '质量等级
LrText(0).Text = ""
Else
Imgebo_Mnumber.Text = Trim(!gradename & "")
LrText(0).Text = Trim(!gradename)
End If
If TeStr Then
LrText(9).Text = Trim(!Maker & "") '制单人
If IsDate(.Fields("MakeDate")) Then LrText(10).Text = Format(Trim(!MakeDate & ""), "yyyy-mm-dd") '制单日期
LrText(11).Text = Trim(!Checker & "") '审核人
Else
LrText(9).Text = Xtczy
LrText(10).Text = Format(Xtrq, "yyyy-mm-dd")
LrText(11).Text = ""
End If
TextChangeLock = False '文本框解锁
'<<]
End If
'[>>显示单据分录
jsqte = WglrGrid.FixedRows
Do While Not .EOF
WglrGrid.AddItem ""
WglrGrid.TextMatrix(jsqte, 0) = "*" '数据有效行标识(必填)
WglrGrid.TextMatrix(jsqte, 1) = Trim(.Fields("itemcode") & "") '检验项目代码
WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("itemname") & "") '检验项目名称
If Val(Lab_Djclzt.Caption) = 2 Then
WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("stand") & "") '检验标准
Else
WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = ""
End If
WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Result") & "") '检验结果
WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("unitname") & "") '计量单位
If TeStr Then
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = IIf(Val(!ifaffect & ""), 0, !ifaffect)
Else
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = 0
End If
WglrGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
If Val(Lab_Djclzt.Caption) <> 2 Then
str_TempSql = "SELECT DISTINCT GradeCode FROM QC_V_ProductStand where MNumber='" & Trim(LrText(1)) & "' and CONVERT(int, GradeCode)<'" & Val(Trim(TsLabel(0).Tag)) & "' order by GradeCode"
Set rs_TempB = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
If Not rs_TempB.EOF Then rs_TempB.MoveLast
str_TempSql = "SELECT DISTINCT itemcode,stand,GradeCode FROM QC_V_ProductStand where MNumber='" & Trim(LrText(1)) & "' and GradeCode='" & Trim(rs_TempB!GradeCode & "") & "'"
Set rs_TempB = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
For i = WglrGrid.FixedRows To WglrGrid.Rows - 1
If WglrGrid.TextMatrix(i, 0) <> "*" Then Exit For
rs_TempB.MoveFirst
If Not rs_TempB.EOF Then
rs_TempB.Find "itemcode='" & Trim(WglrGrid.TextMatrix(i, 1)) & "'"
If Not rs_TempB.EOF Then
WglrGrid.TextMatrix(i, Sydz("002", GridStr(), Szzls)) = Trim(rs_TempB!stand & "")
TsLabel(0).Tag = Trim(rs_TempB!GradeCode)
Else
WglrGrid.TextMatrix(i, Sydz("002", GridStr(), Szzls)) = ""
End If
Else
WglrGrid.TextMatrix(i, Sydz("002", GridStr(), Szzls)) = ""
End If
Next i
'*********自动判断降等因素*************************************
' On Error Resume Next
result = 0
stand = ""
For jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
If Trim(WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) & "") <> "" And Trim(WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) & "") <> "" Then
result = Val(Trim(WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) & ""))
stand = Trim(WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) & "")
PanDuanFu = Trim(Left(stand, 1))
If IsNumeric(PanDuanFu) Then
If InStr(stand, "～") <> 0 Then
If result > Val(Right(stand, Len(stand) - InStr(stand, "～"))) Or result < Val(Left(stand, InStr(stand, "～") - 1)) Then
If_Demotion = True
End If
End If
Else
If PanDuanFu = "≤" Then
If result > Val(Right(stand, Len(stand) - InStr(stand, "≤"))) Then
If_Demotion = True
End If
ElseIf PanDuanFu = "≥" Then
If result < Val(Right(stand, Len(stand) - InStr(stand, "≥"))) Then
If_Demotion = True
End If
ElseIf PanDuanFu = ">" Then
If result <= Val(Right(stand, Len(stand) - InStr(stand, ">"))) Then
If_Demotion = True
End If
ElseIf PanDuanFu = "<" Then
If result >= Val(Right(stand, Len(stand) - InStr(stand, "<"))) Then
If_Demotion = True
End If
End If
End If
If If_Demotion = True Then
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = True
End If
If_Demotion = False
result = 0
stand = ""
End If
Next jsqte
'******************************************************************************
End If
'调整网格(Fixed)
Call Sub_AdjustGrid
'计算合计数据(Fixed)
For jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(jsqte)
Next jsqte
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
'设置审核弃审按钮状态
Call Sub_CheckStatus
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
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)
WglrGrid.Enabled = 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 '退出
.Buttons("sc").Visible = False
'设置文本框录入状态
Call Sub_LrtextStatus(True)
WglrGrid.Enabled = 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 '增行
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -