Excel VBA替代SendKeys方案求助：无法向Paint发送粘贴指令

SendKeys本质是模拟全局键盘输入，依赖窗口焦点和系统时机，稳定性极差——你的代码里不仅提前发送了无效的^V，固定1秒等待也无法适配Paint的实际启动速度，很容易导致指令失效。以下是两种更可靠的替代方案：

方案一：直接导出图片并让Paint打开（最稳定） #

跳过剪贴板和模拟操作，直接将Excel中的图片导出为临时文件，再调用Paint打开该文件，完全避免SendKeys的不确定性。

Sub ExportPicToPaint()
    Dim targetPic As Shape
    Dim tempImagePath As String
    
    ' 定位目标图片
    Set targetPic = ActiveSheet.Shapes("Picture 2")
    
    ' 生成系统临时目录下的图片路径
    tempImagePath = Environ("TEMP") & "\temp_excel_pic.png"
    
    ' 将图片导出为PNG格式（无需额外引用的话，把pbPNG换成3）
    targetPic.Export tempImagePath, pbPNG
    
    ' 调用Paint打开临时图片（用双引号包裹路径避免空格问题）
    Shell Environ("windir") & "\system32\mspaint.exe " & Chr(34) & tempImagePath & Chr(34), vbMaximizedFocus
    
    ' 可选：后续自动删除临时文件（需确保Paint已读取完成）
    ' Application.Wait Now + TimeValue("0:00:02")
    ' Kill tempImagePath
End Sub

注：如果不想引用Microsoft Office Object Library，将代码中的pbPNG替换为数值3即可（PNG格式的枚举值）。

方案二：用Windows API精准发送粘贴指令 #

如果必须通过剪贴板实现，可借助Windows API获取Paint窗口句柄，确保窗口加载完成后直接向编辑区域发送粘贴消息，比SendKeys可靠得多。

' 声明Windows API函数（64位VBA需加PtrSafe）
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Const WM_PASTE = &H302 ' 粘贴消息的常量值

Sub CopyPicToPaintViaAPI()
    Dim targetPic As Shape
    Dim paintMainHWnd As LongPtr
    Dim paintEditHWnd As LongPtr
    Dim waitStart As Double
    
    ' 将图片复制到剪贴板（用CopyPicture确保是位图格式，兼容Paint）
    Set targetPic = ActiveSheet.Shapes("Picture 2")
    targetPic.CopyPicture xlScreen, xlBitmap
    
    ' 启动Paint
    Shell Environ("windir") & "\system32\mspaint.exe", vbNormalFocus
    
    ' 等待Paint主窗口加载，最多等待5秒
    waitStart = Now
    Do
        paintMainHWnd = FindWindow("MSPaintApp", vbNullString)
        DoEvents
    Loop Until paintMainHWnd <> 0 Or Now > waitStart + TimeValue("0:00:05")
    
    If paintMainHWnd = 0 Then
        MsgBox "Paint窗口启动超时，请重试"
        Exit Sub
    End If
    
    ' 获取Paint的编辑区域句柄（不同Paint版本类名可能不同，如AfxWnd100w）
    paintEditHWnd = FindWindowEx(paintMainHWnd, 0, "MSPaintView", vbNullString)
    paintEditHWnd = FindWindowEx(paintEditHWnd, 0, "AfxWnd100u", vbNullString)
    
    ' 激活Paint窗口并发送粘贴指令
    SetForegroundWindow paintMainHWnd
    SendMessage paintEditHWnd, WM_PASTE, 0, 0
End Sub

注：若你的Paint版本编辑区域类名不是AfxWnd100u，可使用Spy++工具查看实际类名替换即可。

原代码的核心问题 #

1. 先执行的SendKeys "^V"在Paint未启动时完全无效；
2. 固定1秒等待无法适配不同系统的Paint启动速度，窗口可能还未加载完成就发送了指令；
3. SendKeys是全局模拟输入，若期间其他窗口抢焦点，指令会被发送到错误窗口。

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