求助：Excel VBA图片框右键MouseUp事件延迟，左键无此问题

看起来你的核心问题是右键快速连续点击时事件丢失，结合你的代码和场景，我来拆解下原因和解决办法：

为什么右键点击会有延迟/丢失？ #

主要有两个关键原因：

1. Excel默认右键菜单抢占资源：当你右键点击图片控件时，Excel会自动弹出上下文菜单，这个菜单的渲染过程会阻塞MouseUp事件的响应，快速点击时后面的事件直接被系统丢弃了。
2. 逐行插入行的操作太耗时：你每次点击都执行Range("X2:Z2").Insert，这是非常耗时的工作表IO操作，连续点击时前一次的插入还没完成，后一次的点击事件就被队列阻塞，甚至直接丢失。

具体解决步骤 #

1. 阻止右键菜单弹出，消除事件干扰

添加一个MouseDown事件来拦截右键的默认菜单行为，这样右键点击不会触发菜单，事件能顺畅响应：

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' 检测到右键点击时，临时禁用单元格右键菜单
    If Button = 2 Then
        Application.CommandBars("Cell").Enabled = False
    End If
End Sub

2. 优化数据写入逻辑，用批量操作替代逐行插入

把每次点击的数据先缓存到集合里，积累到一定数量再批量写入工作表，避免频繁的插入行操作：
首先在工作表模块顶部定义一个模块级集合用来缓存数据：

' 模块级变量，缓存点击记录（仅当前工作表有效）
Private clickRecords As Collection

然后初始化集合（在工作表激活时）：

Private Sub Worksheet_Activate()
    Set clickRecords = New Collection
End Sub

修改你的MouseUp事件，改为缓存数据+批量写入：

Public Sub Image1_MouseUp(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, _
 ByVal Y As Single)
    Dim finalX As Single
    Dim record As Variant
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 处理X坐标的上限逻辑
    finalX = Round(X)
    If Application.WorksheetFunction.Ceiling_Math(finalX, 10) >= 310 Then
        finalX = 310
    End If
    
    ' 构建本次点击的记录
    record = Array(finalX, Round(Y), IIf(Button = 1, "H", "M"))
    clickRecords.Add record
    
    ' 更新状态栏
    Application.StatusBar = IIf(Button = 1, "Hit Recorded", "Miss Recorded")
    ClearStatusBar ' 注意：后面要优化这个过程
    
    ' 每5次点击批量写入一次（可根据需求调整数量）
    If clickRecords.Count >= 5 Then
        WriteRecordsToSheet
    End If
    
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.CommandBars("Cell").Enabled = True ' 恢复右键菜单
End Sub

' 批量写入缓存的记录到工作表
Private Sub WriteRecordsToSheet()
    Dim lastRow As Long
    Dim outputArr As Variant
    Dim i As Integer
    
    ' 找到X列最后一行数据的位置
    lastRow = Me.Cells(Me.Rows.Count, "X").End(xlUp).Row
    If lastRow < 2 Then lastRow = 1 ' 如果没有数据，从第2行开始
    
    ' 准备批量写入的数组
    ReDim outputArr(1 To clickRecords.Count, 1 To 3)
    For i = 1 To clickRecords.Count
        outputArr(i, 1) = clickRecords(i)(0)
        outputArr(i, 2) = clickRecords(i)(1)
        outputArr(i, 3) = clickRecords(i)(2)
    Next i
    
    ' 一次性写入，比逐行插入快10倍以上
    Me.Cells(lastRow + 1, "X").Resize(clickRecords.Count, 3).Value = outputArr
    
    ' 清空缓存
    Set clickRecords = New Collection
End Sub

' 工作表切换/关闭时，写入剩余的缓存记录
Private Sub Worksheet_Deactivate()
    If clickRecords.Count > 0 Then
        WriteRecordsToSheet
    End If
End Sub

3. 优化ClearStatusBar过程，避免阻塞事件

如果你的ClearStatusBar用了Application.Wait这类阻塞式等待，会严重影响连续点击的响应。改成用OnTime异步清除：

Sub ClearStatusBar()
    ' 1秒后异步清除状态栏，不会阻塞当前事件
    Application.OnTime Now + TimeValue("0:00:01"), "ResetStatusBar"
End Sub

Sub ResetStatusBar()
    Application.StatusBar = False
End Sub

测试效果 #

这样修改后，右键快速连续点击（160次/分钟）的情况下，应该能完整捕获所有点击事件了。批量写入的方式也大幅降低了工作表操作的耗时，整体响应速度会提升很多。

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