📄 bos_qmchybill.cls
字号:
Exit Sub
End If
If rs!Fstatus = 2 Then
MsgBox "该单据已经引用，不允许驳回审核！", , "金蝶提示"
Cancel = True
Exit Sub
End If
End If
End If
''----------------------------------------------------------------------------------------------------------
End If
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
'序时簿事件
'**********************************************************************************
'**********************************************************************************
Private Sub m_ListInterface_AfterSelList(ByVal RsId As ADODB.Recordset, VectList As KFO.Vector)
''序时簿选择之后触发
On Error GoTo Errhandle
'给选单向量赋值
Set Vector_SelectBill = VectList
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
Private Sub m_ListInterface_AfterMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, ByVal Success As Boolean)
''多级审核发生后
On Error GoTo Errhandle
''一级审核发生时
If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
Dim D As Dictionary
Dim Wl_Index As Long
Set D = m_ListInterface.GetCurrentSelRowInfo()
Set Rs_Chy = m_ListInterface.K3Lib.GetData("select fbillno_yd,fqmstyle from t_ST_QM_Hxd where finterid=" & D.GetValue("FInterID"))
''如果为收料检验(2),委外入库（4），运输协议(7),其他检验(9)，委外出库（8）
If Rs_Chy!Fbillno_yd <> "" And (Rs_Chy!Fqmstyle = "2" Or Rs_Chy!Fqmstyle = "4" Or Rs_Chy!Fqmstyle = "7" Or Rs_Chy!Fqmstyle = "8" Or Rs_Chy!Fqmstyle = "9") Then
Set rs = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.fbillerid,t1.fcheckid,t2.FBillNo_yd,t1.FQualityerId from t_ST_QM_Hxd t1 left join t_ST_QM_Bmd t2 on t1.FBillNo_yd=t2.FInterId where t1.fInterId=" & D.GetValue("FInterID"))
If rs.RecordCount > 0 Then
If rs!Fstatus = 0 Then
''通过保密单更新检验单化验员FchBillerid字段和化验领导Fchcheckid字段的值
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FchBillerid=" & rs!FQualityerId & ",fchcheckid=" & rs!fcheckid & " where finterid=" & rs!Fbillno_yd
End If
End If
End If
''如果为调拔检斤（3），工艺检斤（5），成品入库检斤（6）
If Rs_Chy!Fbillno_yd <> "" And (Rs_Chy!Fqmstyle = "3" Or Rs_Chy!Fqmstyle = "5" Or Rs_Chy!Fqmstyle = "6") Then
Set rs = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.fbillerid,t1.fcheckid,t1.FBillNo_yd,t1.FQualityerId from t_ST_QM_Hxd t1 where t1.fInterId=" & D.GetValue("FInterID"))
If rs.RecordCount > 0 Then
If rs!Fstatus = 0 Then
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=2 where finterid=" & Val(D.GetValue("FInterID"))
''直接通过保密单更新检验单化验员FchBillerid字段和化验领导Fchcheckid字段的值
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FchBillerid=" & rs!FQualityerId & ",fchcheckid=" & rs!fcheckid & " where finterid=" & rs!Fbillno_yd
End If
End If
End If
End If
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
Private Sub m_ListInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
''多级审核发生时
On Error GoTo Errhandle
''一级审核发生时
If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel - 1) Then
Dim D As Dictionary
Dim Wl_Index As Long
Set D = m_ListInterface.GetCurrentSelRowInfo()
Set Rs_Chy = m_ListInterface.K3Lib.GetData("select fbillno_yd,fqmstyle from t_ST_QM_Hxd where finterid=" & D.GetValue("FInterID"))
'结果判定变量
Dim Result_t As Boolean '判断是否合格的最终结果变量
Dim Result_temp As String '判断是否合格的中间结果变量
''如果为收料检验(2),委外入库（4），运输协议(7),其他检验(9)，委外出库（8）
If Rs_Chy!Fbillno_yd <> "" And (Rs_Chy!Fqmstyle = "2" Or Rs_Chy!Fqmstyle = "4" Or Rs_Chy!Fqmstyle = "7" Or Rs_Chy!Fqmstyle = "8" Or Rs_Chy!Fqmstyle = "9") Then
Set rs = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t2.FBillNo_yd from t_ST_QM_Hxd t1 left join t_ST_QM_Bmd t2 on t1.FBillNo_yd=t2.FInterId where t1.fInterId=" & D.GetValue("FInterID"))
If rs.RecordCount > 0 Then
If rs!Fstatus = 0 Then
''更新检验单FBillNo_Hx字段和FResult字段的值
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FBillNo_Hx=" & D.GetValue("FInterID") & " where finterid=" & rs!Fbillno_yd
''将化学检验结果添加到物理检验单中
Set Rs1 = m_ListInterface.K3Lib.GetData("select max(FIndex) as maxid from t_ST_QM_WLDEntry where fInterId=" & rs!Fbillno_yd)
Wl_Index = IIf(IsNull(Rs1!maxid), 0, Rs1!maxid)
Set Rs1 = m_ListInterface.K3Lib.GetData("select * from t_ST_QM_HxdEntry where fInterId=" & D.GetValue("FInterID"))
'开始循环
While Not Rs1.EOF
'-------------------------------------------------------------------------------------------------------------
''如果上限值+下限值<>0,且检验检验值在上下限范围之内，则为合格
If (Val(Rs1!FValue_hx + Val(Rs1!FValue_sx))) <> 0 And Val(Rs1!FValue_hx) >= Val(Rs1!FValue_Xx) And Val(Rs1!FValue_hx) <= Val(Rs1!FValue_sx) Then
Result_temp = "合格"
''如果上限值+下限值<>0,且检验检验值在上下限范围之外，则为不合格
ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) <> 0 And (Val(Rs1!FValue_hx) < Val(Rs1!FValue_Xx) Or Val(Rs1!FValue_hx) > Val(Rs1!FValue_sx)) Then
Result_temp = "不合格"
''如果上限值+下限值=0则不用判断，结果为合格
ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) = 0 Then
Result_temp = "合格"
End If
''如果有一项为“不合格”，结果为不合格
If Result_temp = "不合格" Then
Result_t = True
End If
'-------------------------------------------------------------------------------------------------------------
''当原物理检验单中存在当前检验项目时更新操作
m_ListInterface.K3Lib.UpdateData "if exists(select fid from t_ST_QM_WLDentry where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID & ") update t_ST_QM_WLDEntry set FValue_Wl=" & Rs1!FValue_hx & _
",FNote='" & Result_temp & "',FInterId_Hx=" & D.GetValue("FInterID") & " where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID
''当原物理检验单中不存在当前检验项目时插入操作
m_ListInterface.K3Lib.UpdateData "if not exists(select fid from t_ST_QM_WLDentry where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID & ") INSERT INTO t_ST_QM_WLDEntry(FIndex,FInterId,FId,FValue_Xx," & _
"FValue_Sx,FValue_Wl,FNote,FInterId_Hx) Values(" & Wl_Index & "," & rs!Fbillno_yd & _
"," & Rs1!FID & "," & Rs1!FValue_Xx & "," & Rs1!FValue_sx & "," & Rs1!FValue_hx & ",'" & Result_temp & "'," _
& D.GetValue("FInterID") & ")"
Rs1.MoveNext
Wl_Index = Wl_Index + 1
Wend
''如果化学检验单不合格则对应物理检验单也应为不合格，否则为合格
If Result_t = True Then
Set Rs1 = m_ListInterface.K3Lib.GetData("select FResult from t_ST_QM_WLD where finterid=" & rs!Fbillno_yd)
If Rs1.RecordCount > 0 And Rs1!fresult = "合格" Then
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fresult='不合格' where finterid=" & rs!Fbillno_yd
End If
Else
Set Rs1 = m_ListInterface.K3Lib.GetData("select Fnote from t_ST_QM_WLDentry where fnote='不合格' and finterid=" & rs!Fbillno_yd & " and finterid_hx=0")
If Rs1.EOF Then
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fresult='合格' where finterid=" & rs!Fbillno_yd
End If
End If
End If
End If
End If
''----------------------------------------------------------------------------------------------------------
''如果为调拔检斤（3），工艺检斤（5），成品入库检斤（6）
If Rs_Chy!Fbillno_yd <> "" And (Rs_Chy!Fqmstyle = "3" Or Rs_Chy!Fqmstyle = "5" Or Rs_Chy!Fqmstyle = "6") Then
Set rs = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.FBillNo_yd from t_ST_QM_Hxd t1 where t1.fInterId=" & D.GetValue("FInterID"))
If rs.RecordCount > 0 Then
If rs!Fstatus = 0 Then
''更新检验单FBillNo_Hx字段和FResult字段的值
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FBillNo_Hx=" & D.GetValue("FInterID") & " where finterid=" & rs!Fbillno_yd
''将化学检验结果添加到物理检验单中
Set Rs1 = m_ListInterface.K3Lib.GetData("select max(FIndex) as maxid from t_ST_QM_WLDEntry where fInterId=" & rs!Fbillno_yd)
Wl_Index = IIf(IsNull(Rs1!maxid), 0, Rs1!maxid)
Set Rs1 = m_ListInterface.K3Lib.GetData("select * from t_ST_QM_HxdEntry where fInterId=" & D.GetValue("FInterID"))
While Not Rs1.EOF
'-------------------------------------------------------------------------------------------------------------
''如果上限值+下限值<>0,且检验检验值在上下限范围之内，则为合格
If (Val(Rs1!FValue_hx + Val(Rs1!FValue_sx))) <> 0 And Val(Rs1!FValue_hx) >= Val(Rs1!FValue_Xx) And Val(Rs1!FValue_hx) <= Val(Rs1!FValue_sx) Then
Result_temp = "合格"
''如果上限值+下限值<>0,且检验检验值在上下限范围之外，则为不合格
ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) <> 0 And (Val(Rs1!FValue_hx) < Val(Rs1!FValue_Xx) Or Val(Rs1!FValue_hx) > Val(Rs1!FValue_sx)) Then
Result_temp = "不合格"
''如果上限值+下限值=0则不用判断，结果为合格
ElseIf (Val(Rs1!FValue_Xx) + Val(Rs1!FValue_sx)) = 0 Then
Result_temp = "合格"
End If
''如果有一项为“不合格”，结果为不合格
If Result_temp = "不合格" Then
Result_t = True
End If
'-------------------------------------------------------------------------------------------------------------
''当原物理检验单中存在当前检验项目时更新操作
m_ListInterface.K3Lib.UpdateData "if exists(select fid from t_ST_QM_WLDentry where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID & ") update t_ST_QM_WLDEntry set FValue_Wl=" & Rs1!FValue_hx & _
",FNote='" & Result_temp & "',FInterId_Hx=" & D.GetValue("FInterID") & " where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID
''当原物理检验单中不存在当前检验项目时插入操作
m_ListInterface.K3Lib.UpdateData "if not exists(select fid from t_ST_QM_WLDentry where finterid=" & _
rs!Fbillno_yd & " and fid=" & Rs1!FID & ") INSERT INTO t_ST_QM_WLDEntry(FIndex,FInterId,FId,FValue_Xx," & _
"FValue_Sx,FValue_Wl,FNote,FInterId_Hx) Values(" & Wl_Index & "," & rs!Fbillno_yd & _
"," & Rs1!FID & "," & Rs1!FValue_Xx & "," & Rs1!FValue_sx & "," & Rs1!FValue_hx & ",'" & Result_temp & "'," _
& D.GetValue("FInterID") & ")"
Rs1.MoveNext
Wl_Index = Wl_Index + 1
Wend
''如果化学检验单不合格则对应物理检验单也应为不合格，否则为合格
If Result_t = True Then
Set Rs1 = m_ListInterface.K3Lib.GetData("select FResult from t_ST_QM_WLD where finterid=" & rs!Fbillno_yd)
If Rs1.RecordCount > 0 And Rs1!fresult = "合格" Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -