香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 26th May 2006, 11:14 AM | WB & WS, API / Add-in | (1577 Reads)

Prevent Excel Close

'---------------------------------------------------------------------------------------
' Module    : ThisWorkbook
' DateTime  : 26/5/2006 11:12
' Author    :
' Purpose   : Prevent Excel Close
'---------------------------------------------------------------------------------------
' Tested in WinXp + Office 2003


Option Explicit
Private Sub Workbook_Open()
On Error Resume Next
    'Activate the 1st worksheet using the workbooks worksheet index
    Worksheets(1).Activate
    'Or If you want to use the actual worksheet name
    'Worksheets("
End Sub
 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim Msg, Style, Title, Response
Dim MyFlag As Long, Ret As String
'Set ShutDown Constants
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4

' Define message.
Msg = "Do you want to continue ?" _
    & vbCr & vbCr & "You are about to exit the excel program." _
    & vbCr & vbCr & "You will need to Reboot Computer" _
    & vbCr & "to restore the program!"
Style = vbYesNoCancel + vbCritical + vbDefaultButton3    ' Define buttons.
Title = "Exiting Program"    ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
'Test the variable Response
Select Case Response
  Case vbYes
    'Save the file, Force Windows Closed
    Me.Save
'   Call Exit_Windows
    Ret = InputBox("Enter Password", "Password Required")
        If Ret = "testing" Then    ' 更改你的密碼
        Ret = InputBox("Exit Excel or Logoff User" _
        & vbCr & " Enter: E or L", "What Action")
        Else
        MsgBox "Invalid Password", vbCritical, "Wrong Password"
        Cancel = False
        Exit Sub
        End If
    If Ret = "E" Or Ret = "e" Then
        Application.Quit
    Else
        If
Ret = "L" Or Ret = "l" Then
            SetShutDownPrivilege 'Set the shutdown privilege - else reboot will fail
            ' Always execute a force shutdown if a shutdown is required

            MyFlag = EWX_LOGOFF  'LogOff
            ' Grab the shutdown privilege - else reboot will fail
            SetShutDownPrivilege
            'Do the required action
            Call ExitWindowsEx(MyFlag, 0)
        End If
    End If
  Case
vbNo
    Worksheets(1).Activate
    Cancel = True
  Case
vbCancel
    Cancel = True
  Case Else

  'Do Nothing
End Select

End Sub


'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 26/5/2006 11:12
' Author    :
' Purpose   : Prevent Excel Close
'---------------------------------------------------------------------------------------

' 原碼出自 Tek-Tips Forum

Option Explicit

'Set Types
Public Type LUID
   LowPart As Long
   HighPart As Long
End Type

Public Type
LUID_AND_ATTRIBUTES
        pLuid As LUID
        Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(1) As LUID_AND_ATTRIBUTES
End Type

' Declare API functions.
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, _
   ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
   (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long

Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, _
   ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength _
   As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
' Set Set ShutDown Privilege Constants
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Sub SetShutDownPrivilege()
Dim Phndl As Long, Thndl As Long
Dim MyLUID As LUID
Dim MyPriv As TOKEN_PRIVILEGES, MyNewPriv As TOKEN_PRIVILEGES

Phndl = GetCurrentProcess()
OpenProcessToken Phndl, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, Thndl
LookupPrivilegeValue "", "SeShutdownPrivilege", MyLUID
MyPriv.PrivilegeCount = 1
MyPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
MyPriv.Privileges(0).pLuid = MyLUID
' Now to set shutdown privilege for my app
AdjustTokenPrivileges Thndl, False, MyPriv, 4 + (12 * MyPriv.PrivilegeCount), MyNewPriv, 4 + (12 * MyNewPriv.PrivilegeCount)

End Sub