Vba 双击形状上的事件

在我的研究中，我发现在excel工作表上的形状上没有内置的启用双击事件的功能。我看到的许多变通方法都涉及编写类或其他类似的东西来添加此功能，所有这些似乎都有点超出了我的VBA知识库。因此，我编写了上述代码（目前只是一个测试），试图为形状编写自己的双击功能

Public Clicked As Boolean, LastClickObj As String, LastClickTime As Date


Sub GenerateShapes()
    Dim sheet1 As Worksheet, shape As shape
    Set sheet1 = ThisWorkbook.Worksheets("Sheet1")
    Set shape = sheet1.Shapes.AddShape(msoShapeDiamond, 50, 50, 5, 5)
        shape.OnAction = "ShapeDoubleClick"
    Set shape = sheet1.Shapes.AddShape(msoShapeRectangle, 50, 60, 5, 5)
        shape.OnAction = "ShapeDoubleClick"
    LastClickTime = Now
End Sub


Sub ShapeDoubleClick()

    If Second(Now) - Second(LastClickTime) > 0.5 Then
        Clicked = False
        LastClickObj = ""
        LastClickTime = Now
    Else

        If Not Clicked Then
            Clicked = True
            LastClickObj = Application.Caller
        ElseIf LastClickObj = Application.Caller Then
            MsgBox ("Double Click")
            Clicked = False
            LastClickObj = ""
            LastClickTime = Now - 1
        Else
            LastClickObj = Application.Caller
            Clicked = True
            LastClickTime = Now
        End If
    End If


End Sub

---

然而，考虑到我对计时器的使用方式，如果我连续快速单击三次，代码通常只会执行“双击”。我认为这与我如何处理点击的

超时“重置”有关，但逻辑可能存在其他问题。关于如何在没有其他大量添加（如类等）的情况下正确实现此功能，有什么想法吗？
编辑3：我使用了没有跟踪单元格的初始格式：
我认为它会将时间缩短，因此您必须使用我在上面使用的语法以毫秒为单位使其工作。防止三次单击激活两次双击

Sub ShapeDoubleClick()

    Debug.Print Second(Now) - Second(LastClickTime)

    If Second(Now) - Second(LastClickTime) > 0.3 Then
        LastClickTime = Now

    ElseIf LastClickObj = Application.Caller And Clicked = False Then

            Debug.Print "Double Clicked!"
            Clicked = True
            LastClickTime = Now - 1
            LastClickObj = Application.Caller
            Exit Sub

    End If

    Clicked = False
    LastClickObj = Application.Caller
End Sub

我花了更多的时间来研究这个问题，并通过一些调试意识到三次点击是由我点击的布尔值引起的。我下面的解决方案非常有效，包括形状差异，并且可以在代码中轻松调整单击延迟（我可以在其他地方将其调整为变量集，但目前硬代码功能已经足够）。在此处发布我的解决方案，以供希望向其形状添加双击操作的未来用户使用

Option Explicit

Public LastClickObj As String, LastClickTime As Date

Sub ShapeDoubleClick()

    If LastClickObj = "" Then
        LastClickObj = Application.Caller
        LastClickTime = CDbl(Timer)
    Else
        If CDbl(Timer) - LastClickTime > 0.25 Then
            LastClickObj = Application.Caller
            LastClickTime = CDbl(Timer)
        Else
            If LastClickObj = Application.Caller Then
                MsgBox ("Double Click")
                LastClickObj = ""
            Else
                LastClickObj = Application.Caller
                LastClickTime = CDbl(Timer)
            End If
        End If
    End If

End Sub

本打算删除该跟踪器单元（因为msgbox中断了宏，所以我调试时该跟踪器单元就在那里）。这里的问题是，这不需要在同一个对象上双击（这是必要的，因为最终的实现将包含大量生成的形状）。跟踪器单元格的简单替换只是表示最后一次的另一个公共变量，因此这也是一个简单的解决方法，如果现在只传递整个秒值，我认为这不会正确工作。您知道它是否包含秒的分数吗？请参阅我的编辑。现在唯一的问题是当它超过60秒时，任何低于1秒的东西都可以双击。哈！我还认为点击是三次点击的问题——你找到了一个很好的解决方案。这是一个很好的谜题@DavidG之所以选择使用计时器，是因为它从午夜开始需要几秒钟的时间（因此，如果两次点击跨越午夜，则可能发生唯一可能的跳闸，这在这种用法中极不可能发生）