bos_qmphybill.cls

金蝶地磅称重插件

                'Set rs = m_BillInterface.K3Lib.GetData("select fbillstatus from t_ST_SC_BalanceBill where fid in(" & m_BillInterface.GetFieldValue("Fbillno_yd") & ")")
'                While Not rs.EOF
'
'                    '如果检斤单已经被其他业务单据引用，则不允许进行作废处理
'                    If rs!fbillstatus <> 1 Then
'                       MsgBox "对应检斤单已经进行了业务处理,删除对应的业务单据才能进行作废处理!", , "金蝶提示"
'                       Cancel = True
'                       Exit Sub
'                    End If
'                    rs.MoveNext
'                Wend
                
                '调用子过程，进行当前单据的作废处理
                If MsgBox("是否进行作废处理？", vbOKCancel + vbDefaultButton2, "金蝶提示") = vbOK Then
                   DropBills m_BillInterface.CurBillID                          '作废单据
                   MsgBox "单据作废成功！", , "金蝶提示"
                End If
             ElseIf m_BillInterface.GetFieldValue("Fstatus") = 1 Then
                MsgBox "该单据已经作废!", , "金蝶提示"
                Cancel = True
                Exit Sub
             Else
                MsgBox "该单据不能作废!", , "金蝶提示"
                Cancel = True
                Exit Sub
             End If
        Case Else
    End Select
    Exit Sub
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
  
 
    '新增 作废 菜单对象，并设置属性
    '-------------------------------------------------
    Set oTool = oMenuBar.BOSTools.Add("mnuDrop")
    With oTool
       .Caption = "作废"
       .ToolTipText = "作废"
       .Description = "作废"

       .ShortcutKey = 3
       .Visible = True
       .Enabled = True
       .BeginGroup = False
       .ToolPicture = App.Path & "\Drop.ico"
       .SetPicture 0, vbButtonFace
    End With

    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool      '将菜单对象插入指定工具栏（计算器）后面
    '-------------------------------------------------
    
    '新增 生铁反关 菜单对象，并设置属性
    '-------------------------------------------------
    Set oTool = oMenuBar.BOSTools.Add("mnuFeUnClose")
    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("mnuFeClose")
    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      '将菜单对象插入指定工具栏（计算器）后面
    '-------------------------------------------------
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_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
        ''如果上游单据是检斤时，则执行下面代码
        If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
            
            ''更新检斤单单据体扣杂数量Fdeductweight(解发器算干基数量)
            m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBillentry set FDeductWeight=FDeductWeight where FID in(" & m_BillInterface.GetFieldValue("FBillNo_YD") & ")"
            
            ''更新检斤单中的物理检验单据内码和单据编号
            If m_BillInterface.GetFieldValue("Fitemid_ic", , Enu_ValueType_FDSP) = "102.00001" Then
                m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set FStatus_Wl=" & m_BillInterface.CurBillID & ",FQmBillNo='" & m_BillInterface.GetFieldValue("FBillNo") & "' where FID in(" & m_BillInterface.GetFieldValue("FBillNo_YD") & ")"
            Else
                m_BillInterface.K3Lib.UpdateData "update t_ST_SC_BalanceBill set FStatus_Wl=" & m_BillInterface.CurBillID & ",FQmBillNo='" & m_BillInterface.GetFieldValue("FBillNo") & "' where Fid in(" & m_BillInterface.GetFieldValue("FBillNo_YD") & ")"
            End If
            
            ''如果为“调拔质检”则更新调拔通知单的检验斤数量为 减去扣水后的数量
            If m_BillInterface.GetFieldValue("Fqmstyle") = "3" Then
              Set Rs1 = m_BillInterface.K3Lib.GetData("select fnetweight,FInStockWeight from t_ST_SC_BalanceBillentry where fid in (select fid from  t_ST_SC_BalanceBill where fststus_wl=" & m_BillInterface.CurBillID & ")")
              m_BillInterface.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=" & m_BillInterface.CurBillID & "))"
            End If
            
            ''如果是外购生铁，则调整质检单的数量
            If m_BillInterface.GetFieldValue("Fitemid_ic", , Enu_ValueType_FDSP) = "102.00001" Then
               m_BillInterface.K3Lib.UpdateData "exec BjSp_UpdateQmFeQty 'WLD1'," & m_BillInterface.CurBillID & "," & m_BillInterface.GetFieldValue("FBillNo_Yd") & ",0"
            End If
        End If
        
        ''更新单据显示
        m_BillInterface.BillName = "原料理化单"
        m_BillInterface.SetBillFormCaption "原料理化单"
    End If
    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 = 1 And lCheckStatus = 0 Then
        ''更新物理检验单审核标志
        m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=1 where finterid=" & m_BillInterface.CurBillID
    End If
    
    ''二级审核发生时
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel - 1) Then
       ''如果为其他质检且净重为零，则不允许进行二级审核！
       If m_BillInterface.GetFieldValue("FQmStyle") = "9" And Val(m_BillInterface.GetFieldValue("FQuantity")) = 0 Then
          MsgBox "检验类型为其他检斤且净重为零时，不能进行二级审核！", , "金蝶提示"
          Cancel = True
          Exit Sub
       End If
       
       '取物理检验单单据状态和化学检验单据内码
       Set rs = m_BillInterface.K3Lib.GetData("select Fstatus,FBillNo_Hx,fqmstyle from t_ST_QM_WLD where fInterId=" & m_BillInterface.CurBillID)
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 1 Then
             MsgBox "该单据已经作废，不允许二级审核！", , "金蝶提示"
             Cancel = True
             Exit Sub
          End If
          
          If rs!Fstatus = 2 And rs!FBillNo_Hx > 0 Then
             
             ''更新物理检验单审核标志
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=2 where finterid=" & m_BillInterface.CurBillID
             
             ''更新化学单fstatus
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=2 where finterid=" & rs!FBillNo_Hx
          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_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=2 where finterid=" & m_BillInterface.CurBillID
                Else
                   Cancel = True
                   Exit Sub
                End If
          End If
          ''在物理单的备注中添加审核意见
            Dim ReValue As String
            ReValue = InputBox("二审意见", "请输入二级审核的意见")
            If Trim(ReValue) <> "" Then
               m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fnote=fnote+'---" & ReValue & "' 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 = 1 Then
    
       '取物理检验单的单据状态和化学检验单据内码
       Set rs = m_BillInterface.K3Lib.GetData("select Fstatus,FBmBillerId from t_ST_QM_WLD where fInterId=" & m_BillInterface.CurBillID)
       If rs.RecordCount > 0 Then
          If rs!Fstatus = 0 Then
            ''更新物理检验单审核标志
             m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set Fcheckstatus=0 where finterid=" & m_BillInterface.CurBillID
          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_BillInterface.K3Lib.GetData("select Fstatus,FBillNo_Hx,fbillno_yd from t_ST_QM_WLD where fInterId=" & m_BillInterface.CurBillID)