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

Question

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

这是我目前所做的：

将App.hInstance更改为0&，因为我在App.未定义。

 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

在所有 Declare 旁边添加了 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

但问题是，即使我删除了宏编辑器中的所有错误消息并且我可以运行这个没有问题的宏似乎在幻灯片放映期间什么都不做。即使在运行通过宏 Window 或在显示期间单击“运行宏”的操作按钮后，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

这正是您所需要的:)

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

Macro for disabling ESC key in PowerPoint slide show

vba

powerpoint

office-2016