Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
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
Option Explicit
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 Inventory program." _
& vbCr & vbCr & "You will need to Reboot Computer" _
& vbCr & "to restore the Inventory!"
Style = vbYesNoCancel + vbCritical + vbDefaultButton3 ' Define buttons.
Title = "Exiting Inventory" ' 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 = "xyz" 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
'Do nothing -
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
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("Sheet1").Activate
End Sub