bos_qmphybill.cls

金蝶地磅称重插件

    
        Else
            m_ListInterface.K3Lib.UpdateData "exec BjSp_QmBillBatchCheck " & m_ListInterface.K3Lib.User.UserID & ",0,'" & SelId & "'"
        End If
    End If
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
    ''一级审核发生时
    Dim D As Dictionary
    Set D = m_ListInterface.GetCurrentSelRowInfo()
    
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = 1 And lCheckStatus = 0 Then
        
        ''更新物理检验单审核标志
        m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=1 where finterid=" & D.GetValue("FInterID")
    End If
        
    ''二级审核发生时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel - 1) Then
       Set rs = m_ListInterface.K3Lib.GetData("select Fstatus,FBillNo_Hx,FBillNo_yd,FQmstyle,FQuantity from t_ST_QM_WLD where fInterId=" & D.GetValue("FInterID"))
       If rs.RecordCount > 0 Then
          ''如果为其他质检且净重为零，则不允许进行二级审核！
          If rs!Fqmstyle = "9" And rs!FQuantity = 0 Then
             MsgBox "检验类型为其他检斤且净重为零时，不能进行二级审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
            
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经作废，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
          
          If rs!Fstatus = 2 And rs!FBillNo_Hx > 0 Then
             ''更新物理检验单审核标志
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=2 where finterid=" & D.GetValue("FInterID")
             
             ''更新化学单FStatus为2
             If rs!Fbillno_yd <> "" Then
                m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=2 where finterid=" & rs!FBillNo_Hx
             End If
          End If
          
          '如果化学检验没有进行，则给出提示（用于其他质检二级审核处理）
          If (rs!Fstatus = 0 And rs!FBillNo_Hx = 0) Or (rs!Fstatus = 2 And rs!FBillNo_Hx = 0) Then
                If MsgBox("对应的化学检验还未完成，是否审核！", vbOKCancel + vbDefaultButton2, "金蝶提示") = vbOK Then
                    m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=2 where finterid=" & D.GetValue("FInterID")
                Else
                   Cancel = True
                   Exit Sub
                End If
          End If
          ''在物理单的备注中添加审核意见
            Dim ReValue As String
            ReValue = InputBox("二审意见", "请输入二级审核的意见")
            If Trim(ReValue) <> "" Then
               m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fnote=fnote+'---" & ReValue & "' 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
    Dim D As Dictionary
    Set D = m_ListInterface.GetCurrentSelRowInfo()
    ''一级审核驳回时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckStatus = 1 Then
       Set rs = m_ListInterface.K3Lib.GetData("select Fstatus,FBmBillerId,FBillNo_yd from t_ST_QM_WLD where fInterId=" & D.GetValue("FInterID"))
       If rs.RecordCount > 0 Then
       
          If rs!Fstatus = 0 Then
             ''更新物理检验单审核标志
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=0 where finterid=" & D.GetValue("FInterID")
          End If
          
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经作废，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
          
          If rs!Fstatus = 2 And rs!FBmBillerId > 0 Then
             MsgBox "该单据已经被保密单引用，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
       End If
    End If
    
    ''二级审核驳回时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
       Set rs = m_ListInterface.K3Lib.GetData("select t1.Fstatus,t1.FBillNo_Hx,t1.fbillno_yd,t2.fname Fitemid_icname from t_ST_QM_WLD t1 inner join t_icitem t2 on t1.fitemid_ic=t2.fitemid where fInterId=" & D.GetValue("FInterID"))
       If rs.RecordCount > 0 Then
          
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经作废，不允许驳回审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
          
          ''如果对检斤单被其他业务单据引用，则不允许进行处理
'        If rs.Fields("Fitemid_icname") = "外购生铁" Then
'            Set Rs1 = m_ListInterface.K3Lib.GetData("select t2.FInstockClosed,t2.FIsCompClosed,t2.FMergedFlag  from t_ST_SC_BalanceBill t1 left join t_ST_SC_BalanceBillentry t2 on t1.Fid=t2.fid where t1.fid=" & rs.Fields("Fbillno_yd"))
'        Else
'            Set Rs1 = m_ListInterface.K3Lib.GetData("select t2.FInstockClosed,t2.FIsCompClosed,t2.FMergedFlag  from t_ST_SC_BalanceBill t1 left join t_ST_SC_BalanceBillentry t2 on t1.Fid=t2.fid where t1.fStatus_Wl=" & D.GetValue("FInterID"))
'        End If
        
         If Not Rs1.EOF Then
           If Rs1!FInstockClosed > 0 Then
              MsgBox "对应检斤单已经入库，不允许驳回审核！", , "金蝶提示"        '已经生成入库单
              Cancel = True
              Exit Sub
           End If
           
           If Rs1!FIsCompClosed > 0 Then
              MsgBox "对应检斤单已经结算，不允许驳回审核！", , "金蝶提示"        '已经生成入库单
              Cancel = True
              Exit Sub
           End If
           
           If Rs1!FMergedFlag > 0 Then
              MsgBox "对应检斤单已经合并，不允许驳回审核！", , "金蝶提示"        '已经生成入库单
              Cancel = True
              Exit Sub
           End If
        End If
        
          If rs!Fstatus = 2 And rs!FBillNo_Hx > 0 Then
             
             ''更新物理检验单审核标志
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=1 where finterid=" & D.GetValue("FInterID")
             
             ''将化学检验单恢复到审核前的状态
             m_ListInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=0 where finterid=" & rs!FBillNo_Hx
             
             ''如果上游单据是检斤单，则执行下面代码,更新检斤单入库数量为审核前状态
             If rs!Fbillno_yd <> "" Then
                m_ListInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBillentry set finstockweight=fnetweight/1000-fdeductweight where fid in(" & rs!Fbillno_yd & ")"
             End If
          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

    If m_ListInterface.List.ShowMode = 0 Then
        '*************** 新增调整按钮 ***************
        Set oTool = oMenuBar.BOSTools.Add("mnuAdr")
        With oTool
           .Caption = "调整"
           .ToolTipText = "调整"
           .Description = "调整"
    
           .ShortcutKey = 3
           .Visible = True
           .Enabled = True
           .BeginGroup = False
           .ToolPicture = App.Path & "\get.ico"
           .SetPicture 0, vbButtonFace
        End With
    
        Set oBand = oMenuBar.BOSBands("BandToolBar")
         '将菜单对象插入指定工具栏（计算器）后面
        oBand.BOSTools.InsertAfter "mnuCaculate", oTool
        '********************************************
    
    
        '*************** 新增批量反审核按钮 ***************
'        Set oTool = oMenuBar.BOSTools.Add("mnuUnAllCheck")
'        With oTool
'           .Caption = "批反"
'           .ToolTipText = "批反"
'           .Description = "批反"
'
'           .ShortcutKey = 3
'           .Visible = True
'           .Enabled = True
'           .BeginGroup = False
'           .ToolPicture = App.Path & "\red.ico"
'           .SetPicture 0, vbButtonFace
'        End With
'
'        Set oBand = oMenuBar.BOSBands("BandToolBar")
'         '将菜单对象插入指定工具栏（计算器）后面
'        oBand.BOSTools.InsertAfter "mnuCaculate", oTool
        '********************************************
        
        
        
        '*************** 新增批量审核按钮 ***************
'        Set oTool = oMenuBar.BOSTools.Add("mnuAllCheck")
'        With oTool
'           .Caption = "批审"
'           .ToolTipText = "批审"
'           .Description = "批审"
'
'           .ShortcutKey = 3
'           .Visible = True
'           .Enabled = True
'           .BeginGroup = False
'           .ToolPicture = App.Path & "\white.ico"
'           .SetPicture 0, vbButtonFace
'        End With
'
'        Set oBand = oMenuBar.BOSBands("BandToolBar")
'         '将菜单对象插入指定工具栏（计算器）后面
'        oBand.BOSTools.InsertAfter "mnuCaculate", oTool
        '********************************************
 
    
        '*************** 新增反关按钮 ***************
        Set oTool = oMenuBar.BOSTools.Add("mnuUnC")
        With oTool
           .Caption = "反关"
           .ToolTipText = "反关"
           .Description = "反关"
    
           .ShortcutKey = 3