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

Vba 用于在PowerPoint幻灯片放映中禁用ESC键的宏,vba,powerpoint,office-2016,Vba,Powerpoint,Office 2016,我正在使用Office 2016,我想做一个PowerPoint演示,在这里,您不能只按ESC键退出幻灯片放映,因此您只能通过鼠标与幻灯片交互(或者最终使用组合键退出幻灯片,但不能只单击ESC键)。信息亭模式完成大部分工作,但ESC仍然可用。我知道NoEsc插件,但它不适合我。它只是没有在Ribbon或其他地方向我显示该菜单,而是其他加载项显示了该菜单,它们显示在中的“视图”选项卡旁边的“加载项”选项卡中。所以我在其他网站上找到了一个禁用键盘宏的代码,但它只能在32位上运行,不能在64位上运行。

我正在使用Office 2016,我想做一个PowerPoint演示,在这里,您不能只按ESC键退出幻灯片放映,因此您只能通过鼠标与幻灯片交互(或者最终使用组合键退出幻灯片,但不能只单击ESC键)。信息亭模式完成大部分工作,但ESC仍然可用。我知道NoEsc插件,但它不适合我。它只是没有在Ribbon或其他地方向我显示该菜单,而是其他加载项显示了该菜单,它们显示在中的“视图”选项卡旁边的“加载项”选项卡中。所以我在其他网站上找到了一个禁用键盘宏的代码,但它只能在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&,因为我在该应用程序中遇到错误。没有定义
  • 在所有声明旁边添加了PtrSafe 但随后出现了不匹配,并突出显示了“AddressOf LowLevelKeyboardProc”
  • 所以我将“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
    

    但问题是,即使我在“宏编辑器”(macro editor)中清除了所有错误消息,并且我可以毫无问题地运行此宏,但在幻灯片放映期间它似乎什么也不做。即使在显示期间通过宏窗口运行ESC键或单击“运行宏”的操作按钮,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
    

    谢谢你,也为我的英语不好感到抱歉:)

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


    这正是您所需要的:)

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


    这正是您所需要的:)

    谢谢您,佩特,您发送到这里的网站应该非常有用,但正如我所说,我对编码一无所知,我需要几个月才能理解该网站对我说的话。我真的把LongPtr放在了每个地方,希望它足够工作:/。不知道我需要在上面的代码中修改什么。你请求背后的理由和用例是什么?我只是想知道,如果它这么复杂,也许有更好的方法?我在想象你在做一些基于网络的培训或者其他什么,但是使用PPT?如果我了解您的用例,我可能会建议一种更精简的方法,我正在使用PPT创建交互式应用程序(测验、交互式项目,甚至使用鼠标的游戏/小游戏)。PPT做这件事既简单又快捷,我喜欢这种方式,因为这只是我现在的一个小爱好。我希望这些项目的行为有点像一个真正的应用程序,所以它不是那么明显,它只是一个常规的介绍。这不像是我为工作或其他人做的。我这样做只是为了在空闲时间创造“使用基本工具制作复杂的东西”,有时我需要-->-->以某种方式禁用ESC键,这样你就不能通过单击ESC退出,你只需要用鼠标点击/退出,或者最终用组合键关闭,这是我唯一需要的东西,因为编码是我的致命弱点,我花了很多时间来解决它,但没有成功。我是一名2d/3d艺术家,担任室内设计师和产品设计师,因此我可以轻松制作任何图形内容,但编码。。。从来没有时间去学习它。我知道,我知道,有很多程序,你可以做应用程序/游戏或其他事情,但我选择了在空闲时间的PPT,因为为什么不。是的,我在fiverr上发现了一些有趣的优惠,谢谢:)谢谢你,Peyter,你发到这里的网站应该很有帮助,但正如我所说,我对编码一无所知,要理解那个网站对我说的话需要几个月的时间。我真的把LongPtr放在了每个地方,希望它足够工作:/。不知道我需要在上面的代码中修改什么。你请求背后的理由和用例是什么?我只是想知道,如果它这么复杂,也许有更好的方法?我在想象你在做一些基于网络的培训或者其他什么,但是使用PPT?如果我了解您的用例,我可能会建议一种更精简的方法,我正在使用PPT创建交互式应用程序(测验、交互式项目,甚至使用鼠标的游戏/小游戏)。PPT做这件事既简单又快捷,我喜欢这种方式,因为这只是我现在的一个小爱好。我希望这些项目的行为有点像一个真正的应用程序,所以它不是那么明显,它只是一个常规的介绍。这不像是我为工作或其他人做的。我这样做只是为了在空闲时间创造“使用基本工具制作复杂的东西”,有时我需要-->-->以某种方式禁用ESC键,这样你就不能通过单击ESC退出,你只需要用鼠标点击/退出,或者最终用组合键关闭,这是我唯一需要的东西,因为编码是我的致命弱点,我花了很多时间来解决它,但没有成功。我是一名2d/3d艺术家,担任室内设计师和产品设计师,因此我可以轻松制作任何图形内容,但编码。。。从来没有时间去学习它。我知道,我知道,有很多程序,你可以做应用程序/游戏或其他事情,但我选择在空闲时间使用PPT,因为为什么不呢。是的,我在fiverr上找到了一些有趣的服务,谢谢:)
     Public Sub hookup()
     Call UnhookWindowsHookEx(m_hDllKbdHook)
     m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, 0&, 0&)
     End Sub
    
    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
    
    
    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