bos_qmphybillsec.cls

金蝶地磅称重插件

Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
    On Error GoTo Errhandle
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand

    ''隐藏“保存后新增”选项
    '-------------------------------------------------
    Set oBand = oMenuBar.BOSBands("mnuOption")
    Set oTool = oBand.BOSTools("mnuOptionAfterSaveNew")
    With oTool
        .Visible = False
        .Enabled = False
    End With
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_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
       Set rs = m_BillInterface.K3Lib.GetData("select Fstatus,FInterId,FBillNo_FjYd,FSyNum,fbillno from t_ST_QM_WLD where fInterId=" & m_BillInterface.CurBillID)
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 0 Then

             ''是检斤单时，执行下面代码,更新检斤单FStatus为物理检验单号
             If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
                m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set fstatus_wl=" & m_BillInterface.CurBillID & ",fqmbillno='" & rs!FBillNO & "' where fstatus_wl=" & rs!fbillno_fjyd
             End If
             
             ''如果经过保密则更新保密单,否则更新化学检验单
             If m_BillInterface.GetFieldValue("Fqmstyle") = 2 Or m_BillInterface.GetFieldValue("Fqmstyle") = 7 Or m_BillInterface.GetFieldValue("Fqmstyle") = 9 Or m_BillInterface.GetFieldValue("Fqmstyle") = 4 Or m_BillInterface.GetFieldValue("Fqmstyle") = 8 Then
                m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Bmd set Fsynum_old=Fsynum,fBillNo_yd=" & m_BillInterface.CurBillID & " where fBillNo_yd=" & rs!fbillno_fjyd
                m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Bmd set Fsynum='" & rs!FSyNum & "' where fBillNo_yd=" & rs!fbillno_fjyd
             End If
             
             ''更新化学检验单原单编号
             If m_BillInterface.GetFieldValue("Fqmstyle") = 3 Or m_BillInterface.GetFieldValue("Fqmstyle") = 5 Or m_BillInterface.GetFieldValue("Fqmstyle") = 6 Then
                m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fBillNo_yd=" & m_BillInterface.CurBillID & " where fBillNo_yd=" & rs!fbillno_fjyd
                m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set Fbmnum='" & rs!FSyNum & "' where fBillNo_yd=" & rs!fbillno_fjyd
             End If
             
             ''更新原检验单FStatuso 1,设置检验类型为’作废‘
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=1,fjystyle='作废' where finterid=" & rs!fbillno_fjyd
             
             ''更新复检单Fstatus=2,FBillNo_yd为原物理检验单内码
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fstatus=2,Fbillno_yd=(select Fbillno_yd from t_ST_QM_WLD where finterid=" & rs!fbillno_fjyd & ") where Finterid=" & m_BillInterface.CurBillID
          End If
       End If
    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_WLD 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_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
       Set D = m_ListInterface.GetCurrentSelRowInfo()
       Set rs = m_ListInterface.K3Lib.GetData("select * from t_ST_QM_WLD where finterid=" & D.GetValue("FInterID"))
       
       ''检斤单时，则执行下面代码,更新检斤单FStatus(触发器)
       If rs!Fbillno_yd <> "" <> "" Then
          'm_ListInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set FStatus_Wl=" & D.GetValue("FInterID") & " where FStatus_Wl=" & D.GetValue("FInterID")
          
          ''如果为“调拔质检”则更新调拔通知单的检验斤数量为 减去扣水后的数量
          If rs!Fqmstyle = "3" Then
            Set Rs1 = m_ListInterface.K3Lib.GetData("select fnetweight,FInStockWeight from t_ST_SC_BalanceBillentry where fid in (select fid from  t_ST_SC_BalanceBill where fstatus_wl=" & D.GetValue("FInterID") & ")")
            m_ListInterface.K3Lib.UpdateData "update ICStockBillOrderentry set FBalanceWeight=FBalanceWeight-(" & Rs1!fnetweight & "/1000)+" & Rs1!FInStockWeight & "  where fid in (select Fid_src from t_ST_SC_BalanceBillentry where fid in (select fid from  t_ST_SC_BalanceBill where fstatus_wl=" & D.GetValue("FInterID") & "))"
          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
       Set D = m_ListInterface.GetCurrentSelRowInfo()
       Set rs = m_ListInterface.K3Lib.GetData("select Fstatus,FInterId,FBillNo_FjYd,FSyNum,fBillno_yd,Fqmstyle,fbillno from t_ST_QM_WLD where fInterId=" & D.GetValue("FInterID"))
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 0 Then
             
             ''是检斤时，更新FStatus_wl为物理检验单内码
'             If rs!Fbillno_yd <> "" <> "" Then
'                m_ListInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set fstatus_wl=" & D.GetValue("FInterID") & ",fqmbillno='" & rs!FBillNO & "' where fstatus_wl=" & rs!fbillno_fjyd
'             End If
                      
             ''更新保密单,保存原试样编号，更新新的试样编号
             If rs!Fqmstyle = 2 Or rs!Fqmstyle = 7 Or rs!Fqmstyle = 9 Or rs!Fqmstyle = 4 Or rs!Fqmstyle = 8 Then
                m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Bmd set Fsynum_old=Fsynum,fBillNo_yd=" & D.GetValue("FInterID") & " where fBillNo_yd=" & rs!fbillno_fjyd
                m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Bmd set Fsynum='" & rs!FSyNum & "' where fBillNo_yd=" & rs!fbillno_fjyd
             End If
             
             ''更新化学检验单原单编号，为物理检验检验单内码，试样编号为
             If rs!Fqmstyle = 3 Or rs!Fqmstyle = 5 Or rs!Fqmstyle = 6 Then
                m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fBillNo_yd=" & rs!FinterID & " where fBillNo_yd=" & rs!fbillno_fjyd
                m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set Fbmnum='" & rs!FSyNum & "' where fBillNo_yd=" & rs!fbillno_fjyd
             End If
    
             ''更新原检验单为作废状态
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=1,fjystyle='作废' where finterid=" & rs!fbillno_fjyd
             
             ''更新复检单，原单编号更新为检验斤单内码
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fstatus=2,Fbillno_yd=(select Fbillno_yd from t_ST_QM_WLD where finterid=" & rs!fbillno_fjyd & ") where Finterid=" & D.GetValue("FInterID")
          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 = 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_WLD 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=110001306 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_WLD where fbillerid=" & m_ListInterface.K3Lib.User.UserID)
        If rs.EOF Then
             ''锁定过滤菜单和工具栏按钮
             'm_ListInterface.List.ListFilterString = "fcheckid>0"
             m_ListInterface.List.ListFilterString = m_ListInterface.List.ListFilterString & IIf(Trim(m_ListInterface.List.ListFilterString) = "", " fcheckid>0 ", " and fcheckid>0 ")
             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