Макрос для отключения клавиши ES C в слайд-шоу PowerPoint

Question

Я использую Office 2016 и хочу сделать презентацию PowerPoint, в которой вы не можете выйти из слайд-шоу, просто нажав клавишу ES C, поэтому вы можете взаимодействовать со слайдами только с помощью мыши (или в конечном итоге выйти из него с помощью комбинацию клавиш, но не просто нажав ES C). Режим киоска выполняет большую часть работы, но ES C по-прежнему доступен. Я знаю о надстройке NoEs c, но у меня она не работает. Он просто не показывает мне это меню на ленте или где-либо еще, но другие надстройки показывают, и они появляются на вкладке надстроек рядом с вкладкой «Просмотр». Итак, я нашел код на другом веб-сайте для отключения макроса клавиатуры, но он работает только на 32 -bit и не может работать на 64-битной. Я не кодировщик, поэтому мне нужна небольшая помощь, как заставить его работать на 64-битной или 32 + 64-битной.

Вот исходный код с веб-сайта:

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

И вот что я сделал до сих пор:

1. Измените App.hInstance на 0 &, потому что у меня возникла ошибка в этом приложении. не определено.

 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
 End Sub

Кому

 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
 End Sub

Добавлен PtrSafe рядом со всеми Declare, но тут появилось несоответствие и выделено «AddressOf LowLevelKeyboardPro c»

 Public Sub hookup()
 Call UnhookWindowsHookEx(m_hDllKbdHook)
 m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
 End Sub

Итак, я изменил «lpfn As Long» на «lpfn As LongPtr» и тогда ошибка несоответствия исчезнет.

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

К

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

Но проблема в том, что даже если я избавился от всех сообщений об ошибках в редакторе макросов, и я могу запустить этот макрос без проблемы вроде ничего не делает во время слайд-шоу. Клавиша ES C по-прежнему работает даже после ее запуска из окна макросов или нажатия кнопки действия для «Запустить макрос» во время показа.

В параметрах Office для макросов установлено значение «Всегда включен» (самый низкий режим безопасности), а для презентации - сохранен как (.ppsm), поэтому в формате с поддержкой макросов.

Вот мой полностью измененный код:

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

Спасибо и извините за мой плохой английский sh:)

Answer 1

Раньше это было большой проблемой, когда люди глубоко погружались в функции API Excel. К счастью, на этом веб-сайте есть много всего, что вам нужно, в одном месте:

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

Это почти то, что вам нужно :)