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