Question

在我的研究中，我发现没有内置功能可以在Excel工作表上的Shapes上启用双击事件。我看到的许多变通方法都涉及编写类或其他类似的东西以添加此功能，所有这些似乎都超出了我的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

然而，考虑到我对计时器进行了编码的方式，如果我快速连续点击三次，代码通常只会执行“双击”。我认为它与我如何处理Clicked的超时“重置”有关，但逻辑上可能存在其他问题。关于如何正确实现此功能的任何想法没有其他广泛的添加（如类等）？

Answer 1

编辑3：我使用了您的初始格式，没有跟踪单元格：我认为它会缩短时间，所以你必须使用我上面使用的语法让它在毫秒内工作。防止三次点击激活2次双击。

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

Answer 2

花了一些时间看这个，并通过一些调试实现了三次点击是由我点击的布尔值引起的。我在下面的解决方案完美地工作，包括形状区别，并且可以在代码中轻松调整点击延迟（我可以将其调整为其他地方的变量集，但是现在硬编码功能就足够了）。在此处为希望将双击操作添加到其形状的未来用户发布我的解决方案

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

在形状上双击事件

2 个答案: