Vba 鼠标按下事件计时

我被要求在Excel中对点击图像的功能进行编码，并在其上添加一个形状（这是物理治疗师的身体示意图，该形状将指示患者的疼痛部位）。我的代码通过使用ActiveX图像控件的鼠标按下事件来完成此操作：

Private Sub bodypic_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)

ClickShape x, y

End Sub

---

问题是，当鼠标光标位于图表上时，图形不可见。只有当鼠标离开图表时，图形才会出现

我试着刷新屏幕，选择一个单元格，甚至通过。除了用户实际移动鼠标外，似乎什么都不起作用

---

重新创建问题：插入一个大约200 x 500 px的ActiveX图像控件，向控件中添加一个jpeg图像，将鼠标下键代码添加到工作表中，并将单击形状代码添加到模块中。

这是一个非常棘手的问题，但我发现隐藏和取消隐藏图像可以解决问题：

ActiveSheet.Shapes("bodypic").Visible = False
ActiveSheet.Shapes("bodypic").Visible = True
End Sub

---

我欢迎更优雅的回答

我使用此代码的成功率有限：-

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer

Sub ClickShape(ByVal x As Single, ByVal y As Single)

    Dim Shp As Shape
    Dim Pos As POINTAPI

    GetCursorPos Pos
    SetCursorPos Pos.x + 300, Pos.y
    With ActiveSheet
        With .Shapes("bodypic")
            x = x + .Left
            y = y + .Top
        End With
        Set Shp = .Shapes.AddShape(msoShapeMathMultiply, x, y, 26, 26)
    End With

    With Shp
        .Name = "Mark1"
        .Line.Visible = False
        With .Fill
            .ForeColor.RGB = RGB(255, 0, 0)
            .BackColor.RGB = RGB(255, 0, 0)
        End With
    End With
End Sub

本质上，它所做的是将光标移出图像。然后，大约需要一秒钟的时间标记才会出现。标记越多，延迟时间就越长。请注意，我的300像素移动是随机的。您必须确定将其移动到何处，只要它位于图像之外。我试着马上把它移回去，但没有成功，而且由于延迟的变化，返回的时间安排会很棘手

我尝试了另一个概念，我首先创建了标记，并使其不可见。然后，在MouseUp（MouseUp是更合适的事件）上，我移动了标记并使其可见。这是更快的，但它限制了你一个单一的标记或迫使你大量的名称管理。给标记命名是那个实验的一个遗留问题。实际上，它看起来很不错，因为我可以通过反复点击不同的位置来移动标记。如果你只需要一个标记，我建议你继续这个想法

---

如果您需要几个标记，我的实验的另一个遗留问题是添加一个功能来删除（或隐藏）标记，可能是双击。

而不是鼠标向下，您不能只使用单击事件吗？同样的事情，但最有可能解决问题的是“点击事件”，我字面上的意思是“点击（）”事件。据我所知，Excel中没有这样的事件。你能为_Click（）发布一个文档链接吗？刚刚意识到你指的是形状点击事件。我需要返回鼠标光标相对于图像的位置（以考虑不同的屏幕分辨率、窗口状态等），您将如何使用_Click（）实现这一点？有时最佳解决方案并不完美。

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer

Sub ClickShape(ByVal x As Single, ByVal y As Single)

    Dim Shp As Shape
    Dim Pos As POINTAPI

    GetCursorPos Pos
    SetCursorPos Pos.x + 300, Pos.y
    With ActiveSheet
        With .Shapes("bodypic")
            x = x + .Left
            y = y + .Top
        End With
        Set Shp = .Shapes.AddShape(msoShapeMathMultiply, x, y, 26, 26)
    End With

    With Shp
        .Name = "Mark1"
        .Line.Visible = False
        With .Fill
            .ForeColor.RGB = RGB(255, 0, 0)
            .BackColor.RGB = RGB(255, 0, 0)
        End With
    End With
End Sub