📄 bos_qmchybillsec.cls
字号:
End If
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
Private Sub m_BillInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
''驳回审核时触发
On Error GoTo Errhandle
''一级审核驳回时
If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
Set rs = m_BillInterface.K3Lib.GetData("select Fstatus from t_ST_QM_Hxd where fInterId=" & m_BillInterface.CurBillID)
If rs.RecordCount > 0 Then
If rs!Fstatus = 2 Then
MsgBox "该单据已经引用,不允许驳回审核!", , "金蝶提示"
Cancel = True
Exit Sub
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_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 = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.FInterId,t1.FBillNo_FjYd,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
''更新原化学单为作废状态
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=1,fjystyle='作废' where finterid=" & rs!fbillno_fjyd
''更新当前化学单原单编号为作废前的原单编号
m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set Fstatus=2,Fbillno_yd=(select Fbillno_yd from t_ST_QM_Hxd where finterid=" & rs!fbillno_fjyd & ") where Finterid=" & D.GetValue("FInterID")
Set rs = m_ListInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.FInterId,t1.FBillNo_FjYd,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"))
''将化学检验结果添加到物理检验单中
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"))
''添加之前将物理检验单中的化学检验结果删除
m_ListInterface.K3Lib.GetData ("delete from t_ST_QM_WLDEntry where fInterId_hx=" & rs!fbillno_fjyd & " and FInterId=" & rs!Fbillno_yd)
Dim Result_t As Boolean '判断是否合格的最终变量
Dim Result_temp As String '判断是否合格的中间变量
'开始循环
While Not Rs1.EOF
''判断检验结果是否合格
'----------------------------------------------------------------------------------------------------------------------------
''开始判断是否合格
''如果上限值+下限值<>0,且检验检验值在上下限范围之内,则为合格
If (Val(Rs1!FValue_Xx) + 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 "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
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
Private Sub m_ListInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
''驳回审核时触发
On Error GoTo Errhandle
''一级审核驳回时
If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
Dim D As Dictionary
Set D = m_ListInterface.GetCurrentSelRowInfo()
Set rs = m_ListInterface.K3Lib.GetData("select Fstatus from t_ST_QM_Hxd where fInterId=" & D.GetValue("FInterID"))
If rs.RecordCount > 0 Then
If rs!Fstatus = 2 Then
MsgBox "该单据已经引用,不允许驳回审核!", , "金蝶提示"
Cancel = True
Exit Sub
End If
End If
End If
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
On Error GoTo Errhandle
Dim oTool As K3ClassEvents.BOSTool
Dim oBand As K3ClassEvents.BOSBand
'*************** 开始设置 BOS 原有菜单 ***************
'隐藏“下推”菜单
Set oBand = oMenuBar.BOSBands("menu")
Set oTool = oBand.BOSTools("mnuPushBill")
With oTool
.Visible = False
.Enabled = True
End With
'隐藏“上查”工具档按钮
Set oBand = oMenuBar.BOSBands("BandToolBar")
Set oTool = oBand.BOSTools("mnuDataViewPrvBill")
With oTool
.Visible = False
.Enabled = True
End With
'隐藏“下查”工具档按钮
Set oBand = oMenuBar.BOSBands("BandToolBar")
Set oTool = oBand.BOSTools("mnuDataViewNextBill")
With oTool
.Visible = False
.Enabled = True
End With
'*************** 结束设置 BOS 原有菜单 ***************
''根据当前操作员来判断是否显示“过滤”按钮
'-----------------------------------------------
If m_ListInterface.List.ShowMode = 0 Then
''如果为审核人时,按原过滤条件过滤
Set rs = m_ListInterface.K3Lib.GetData("select fcheckman from ICClassMCMan where fid=110001320 and fchecklevel=1 and fcheckman=" & m_ListInterface.K3Lib.User.UserID)
If Not rs.EOF Then
''显示过滤菜单和工具栏按钮
'm_ListInterface.List.ListFilterString = "1=1"
Set oBand = oMenuBar.BOSBands("BandToolBar")
Set oTool = oBand.BOSTools("mnuDataFilter")
With oTool
.Visible = True
.Enabled = True
End With
Exit Sub
Exit Sub
End If
''如果为制单人时,按原过滤条件过滤,否则看不到任何化学复检单
Set rs = m_ListInterface.K3Lib.GetData("select fbillerid from t_ST_QM_Hxd where fbillerid=" & m_ListInterface.K3Lib.User.UserID)
If rs.EOF Then
''锁定过滤菜单和工具栏按钮
m_ListInterface.List.ListFilterString = "1=2"
Set oBand = oMenuBar.BOSBands("BandToolBar")
Set oTool = oBand.BOSTools("mnuDataFilter")
With oTool
.Visible = False
.Enabled = False
End With
Exit Sub
Else
''显示过滤菜单和工具栏按钮
'm_ListInterface.List.ListFilterString = "1=1"
Set oBand = oMenuBar.BOSBands("BandToolBar")
Set oTool = oBand.BOSTools("mnuDataFilter")
With oTool
.Visible = True
.Enabled = True
End With
Exit Sub
End If
End If
'-----------------------------------------------
Exit Sub
Errhandle:
MsgBox err.Description, vbCritical, "金蝶提示"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -