vbapowerpointoffice-2016

Macro for disabling ESC key in PowerPoint slide show


i am using Office 2016 and i want to do a PowerPoint presentation where you can't exit slide show just with hitting ESC key, so you can interact with slides only by your mouse ( or eventually exit it with a key combination but not by just clicking ESC ). Kiosk mode do most of work but still ESC is available. I know about NoEsc add-in but it does not work for me. It just not showing me that menu in Ribbon or elsewhere, but other add-ins do and they appear in Add-ins tab next to View tab in. So i found a code on other website for keyboard disabling macro but it works only on 32-bit and can't run on 64-bit. Im not a coder so i need a little help how can i make it work on 64-bit or 32+64-bit.

Here is an original code from website:

Option Explicit
 
'Esc Disable Key
Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const VK_ESCAPE = &H1B
 
Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type
   Dim Response As Integer
 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public m_hDllKbdHook As Long
 
 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
 End Sub
 
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static kbdllhs As KBDLLHOOKSTRUCT
 
If nCode = HC_ACTION Then
      Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
     If (kbdllhs.vkCode = VK_ESCAPE) Then
       LowLevelKeyboardProc = 1
     End If
End If
End Function

And Here is what i did so far:

  1. Change App.hInstance to 0&, because i got an error that App. is not defined.
 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
 End Sub

To

 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
 End Sub
  1. Added PtrSafe next to all Declare But then mismatch appeared here and highlight "AddressOf LowLevelKeyboardProc"
 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
 End Sub

So i changed "lpfn As Long" to "lpfn As LongPtr" and then mismatch error is gone.

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

To

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

But the problem is, even if i got rid of all error messages in macro editor and i can run this macro with no troubles seems like it does nothing during slide show. ESC key is still working even after running it by Macro Window or clicking action button for "Run macro" during show.

Macros are set to Always Enabled ( Lowest security mode ) in Office Options and presentation is saved as (.ppsm), so macro-enabled format.

Here is my full modified code:


Option Explicit
 
'Esc Disable Key
Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const VK_ESCAPE = &H1B
 
Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type
   Dim Response As Integer
 
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public m_hDllKbdHook As Long
 
 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
 End Sub
 
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static kbdllhs As KBDLLHOOKSTRUCT
 
If nCode = HC_ACTION Then
      Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
     If (kbdllhs.vkCode = VK_ESCAPE) Then
       LowLevelKeyboardProc = 1
     End If
End If
End Function

Thank you, and sorry for my bad english :)


Solution

  • This used to be a big problem when people were deep diving into Excel API functions. Luckily this website has a lot of what you need all in one spot:

    https://jkp-ads.com/Articles/apideclarations.asp

    It's pretty much what you need : )