⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bos_qmchybillsec.cls

📁 金蝶地磅称重插件
💻 CLS
📖 第 1 页 / 共 2 页
字号:
    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 + -