PowerPoint中VBA SendKeys无法实现截图功能

我在MS Excel中成功实现了截图功能，但在PowerPoint中却无法运行。我使用一款支持Alt+PRTSC快捷键的专有截图工具，但即使不用该工具，也无法在PPT外发送PRTSC按键指令，不过发送文本字符串是正常的。尝试过的VBA代码如下：

Sub Screenshot

Dim shp As Shape
Dim stringPRINTSCREEN As String

stringPRINTSCREEN = "(%{PRTSC})" 'doesnt work
stringPRINTSCREEN = "%{PRTSC}" 'doesnt work
stringPRINTSCREEN = "{PRTSC}" 'doesnt work
stringPRINTSCREEN = "%{1068}" 'this just flat out gives me an error for whatever reason

    SendKeys stringPRINTSCREEN, True '% is alt. send printscreen
    DoEvents
    Sleep 1500

ActivePresentation.Slides(1).Shapes.Paste

End Sub

1. 改用Windows API模拟按键（更稳定） #

SendKeys在PowerPoint中常因窗口焦点、权限问题失效，用API模拟按键可靠性更高。将以下代码添加到你的模块中：

Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Const VK_MENU = &H12 'Alt键的虚拟键码
Const VK_SNAPSHOT = &H2C 'PRTSC键的虚拟键码
Const KEYEVENTF_KEYUP = &H2 '按键抬起标识

Sub Screenshot_UsingAPI()
    '按下Alt
    keybd_event VK_MENU, 0, 0, 0
    '按下PRTSC
    keybd_event VK_SNAPSHOT, 0, 0, 0
    '松开PRTSC
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    '松开Alt
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    
    '等待截图写入剪贴板
    Sleep 1000
    DoEvents
    
    '粘贴到幻灯片，添加错误捕获防止剪贴板无内容报错
    On Error Resume Next
    ActivePresentation.Slides(1).Shapes.Paste
    On Error GoTo 0
End Sub

2. 切换窗口焦点（针对截取PPT外部内容） #

如果需要截取PPT以外的区域，先让PPT窗口暂时失去焦点，比如最小化：

Sub Screenshot_WithFocusSwitch()
    '最小化PPT窗口
    Application.WindowState = ppWindowMinimized
    Sleep 500 '等待窗口状态切换完成
    
    '模拟Alt+PRTSC按键
    keybd_event VK_MENU, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    
    Sleep 1000
    '恢复PPT窗口
    Application.WindowState = ppWindowNormal
    DoEvents
    
    ActivePresentation.Slides(1).Shapes.Paste
End Sub

3. 检查宏权限设置 #

确保PowerPoint信任宏的运行权限：

• 打开文件>选项>信任中心>信任中心设置
• 宏设置选择"启用所有宏"，同时勾选"信任对VBA项目对象模型的访问"

内容的提问来源于stack exchange，提问作者Piotr Wojtaszek