用于在 PowerPoint 幻灯片放映中禁用 ESC 键的宏

Question

我正在使用 Office 2016，我想做一个 PowerPoint 演示文稿，在该演示文稿中，您无法仅通过按 ESC 键退出幻灯片放映，因此您只能通过鼠标与幻灯片交互（或最终使用组合键退出它，但不只是单击 ESC ）。 Kiosk 模式完成了大部分工作，但仍然可以使用 ESC。我知道 NoEsc 插件，但它对我不起作用。它只是没有在功能区或其他地方显示该菜单，但其他加载项会显示在“查看”选项卡旁边的“加载项”选项卡中。所以我在其他网站上找到了用于键盘禁用宏的代码，但它仅适用于 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&，因为我收到 App.hInstance 错误。未定义。

 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

1. 在所有声明旁边添加了 PtrSafe 但随后出现不匹配并突出显示“AddressOf LowLevelKeyboardProc”

 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

但问题是，即使我摆脱了宏编辑器中的所有错误消息，并且我可以毫无问题地运行这个宏，它似乎在幻灯片放映期间什么也没做。 ESC 键即使在显示期间通过宏窗口运行或单击“运行宏”的操作按钮后仍然有效。

在 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

谢谢你，对不起我的英语不好:)

Answer 1

当人们深入研究 Excel API 函数时，这曾经是一个大问题。幸运的是，这个网站有很多你需要的东西：

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

这正是你所需要的:)