bos_rpcontract.cls

金蝶地磅称重插件

    UpdateChecker 11, lCheckLevel
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)
    UpdateChecker 12, lLastCheckTo
End Sub

Private Sub UpdateChecker(ByVal iCheckType As Integer, lCheckLevel As Long)
'iCheckType = 1:单据审核，2:单据反审,11:序时簿审核,12:序时簿反审。
    Dim strSql As String
    Dim strCondi As String
    Dim dctCurrRow As Dictionary
    
    If lCheckLevel <= 0 Then Exit Sub
    
    Select Case iCheckType
        Case 1 '单据审核
            strSql = m_BillInterface.K3Lib.User.UserName
            strCondi = " where FContractID = " & m_BillInterface.CurBillID
        Case 2 '单据反审
            strSql = ""
        strCondi = " where FContractID = " & m_BillInterface.CurBillID
        Case 11 '序时簿审核
            strSql = m_ListInterface.K3Lib.User.UserName
            Set dctCurrRow = m_ListInterface.GetCurrentSelRowInfo()
            strCondi = "where FContractID = " & dctCurrRow.GetValue("FContractID")
        Case 12 '序时簿反审
            strSql = ""
            Set dctCurrRow = m_ListInterface.GetCurrentSelRowInfo()
            strCondi = "where FContractID = " & dctCurrRow.GetValue("FContractID")
    End Select
      
    Select Case lCheckLevel
        Case 1 '科长
            Select Case iCheckType
                Case 1, 2 '1:单据审核，2:单据反审
                    'm_BillInterface.SetFieldValue "FDeptChecker", strSql
                    strSql = "update t_RPContract set FDeptChecker = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_RPContract set FDeptChecker = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
            
        Case 2 '部长
            Select Case iCheckType
                Case 1, 2 '1:单据审核，2:单据反审
                    'm_BillInterface.SetFieldValue "FMainChecker", strSql
                    strSql = "update t_RPContract set FMainChecker = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_RPContract set FMainChecker = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
            
        Case 3 '主管经理
            Select Case iCheckType
                Case 1, 2 '1:单据审核，2:单据反审
                    'm_BillInterface.SetFieldValue "FSubChair", strSql
                    strSql = "update t_RPContract set FSubChair = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_RPContract set FSubChair = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
    End Select
End Sub

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim lngFCheckerID As Long
    Dim lngFContractID As Long
    Dim lngFEntryID As Long
    Dim sFIsClosed As String
    Dim rsRec As Recordset
    
 Select Case BOSTool.ToolName
    Case "mnuZF"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FContractID")
        lngFEntryID = m_ListInterface.GetCurrentSelRowInfo("FEntryID")
        sFIsClosed = "select rp.fchecker,rpe.fisclosed from t_rpcontract rp inner join t_rpcontractentry  rpe on rp.fcontractid = rpe.fcontractid where rp.fcontractid = " & lngFContractID & " and rpe.FEntryID = " & lngFEntryID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFIsClosed)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFIsClosed = rsRec("fisclosed")
        End If
       If sFIsClosed = "Y" Then
            MsgBox "当前分录已经关闭,不需再执行此操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
             If lngFCheckerID > 0 And sFIsClosed = "" Then
                  m_ListInterface.K3Lib.UpdateData "update  t_RPContractEntry set  FIsClosed = 'Y' where FContractID=" & lngFContractID & " and FEntryID = " & lngFEntryID
                  MsgBox "当前分录已成功关闭！", vbInformation + vbOKOnly, "金蝶提示"
                  Exit Sub
             Else
                 MsgBox "当前分录还没有审核或已经关闭，不能进行关闭操作！", vbOKOnly + vbInformation, "金蝶提示"
                 Exit Sub
            End If
        End If
    Case "mnuFZF"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FContractID")
        lngFEntryID = m_ListInterface.GetCurrentSelRowInfo("FEntryID")
        sFIsClosed = "select rp.fchecker,rpe.fisclosed from t_rpcontract rp inner join t_rpcontractentry  rpe on rp.fcontractid = rpe.fcontractid where rp.fcontractid = " & lngFContractID & " and rpe.FEntryID = " & lngFEntryID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFIsClosed)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFIsClosed = rsRec("fisclosed")
        End If
        
        If sFIsClosed <> "Y" Then
            MsgBox "当前分录没有关闭，不能执行打开操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
            m_ListInterface.K3Lib.UpdateData "update  t_RPContractEntry set  FIsClosed = '' where FContractID=" & lngFContractID & " and FEntryID = " & lngFEntryID
            MsgBox "当前分录已成功进行了打开操作！", vbOKOnly + vbInformation, "金蝶提示"
         End If
    Case Else
    End Select
    
End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    If m_ListInterface.List.ShowMode = 2 Then Exit Sub '如果是选单，则不创建新的菜单对象
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 mnuZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuZF")
    With oTool
        .Caption = "关闭"
        .ToolTipText = "关闭"
        .Description = "关闭"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool    '将菜单对象插入指定工具栏
 
    '新增 mnuFZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuFZF")
    With oTool
        .Caption = "打开"
        .ToolTipText = "打开"
        .Description = "打开"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '将菜单对象插入指定工具栏
 
 
'*************** 结束新增 BOS 菜单 ***************
 

End Sub