在VBA中处理activeX按钮上的单击和双击事件

Question

我想分别为VBA中的ActiveX按钮处理单击和双击事件。我的问题是单击和双击都会调用单击事件。有没有办法在双击事件发生时抑制/绕过单击过程？我确信这有一个简单的答案，但在网上找不到任何东西......

Answer 1

来自帮助

如果Click事件中存在代码，则DblClick事件将永远不会触发，因为Click事件是在两者之间触发的第一个事件。因此，Click事件拦截了鼠标单击，因此不会发生DblClick事件。

尝试捕获鼠标按下和鼠标向上，等待500毫秒，如果没有鼠标按下，则只需单击一下，如果等待鼠标按下时间。

DoubleClickSpeed HKCU \ Control Panel \ Mouse

数据类型范围默认值REG_SZ 100 - 900（十进制毫秒数）500

Answer 2

Brad Yundt在this post的Experts-Exchange提供了这个聪明的解决方法。

我以为你已经问过这个问题，如果我弄错了，请告诉我

您可以尝试使用Application.OnTime在说出1秒延迟后安排对左键单击的响应。如果在此期间发生双击或右键单击，则不会发生OnTime子中的leftclick事件。

以下代码位于正在监视的工作表的代码窗格中。请注意，它使用该工作表的代码名称，而不是选项卡名称。

如上所述，代码监视A1：A10左键单击或双击单个单元格。然后它会显示一个消息框，命名单击的单元格和单击类型。

工作表事件代码

Dim bTrapped As Boolean
Dim cel As Range, rgWatch As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(cel, Target) Is Nothing Then
    MsgBox "Doubleclick at " & cel.Address
    bTrapped = True
    Cancel = True
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(cel, Target) Is Nothing Then
    MsgBox "Rightclick at " & cel.Address
    bTrapped = True
    Cancel = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim targ As Range
Set rgWatch = Range("A1:A10")
Set targ = Intersect(Target, rgWatch)
If Not targ Is Nothing Then
    If targ.Cells.Count = 1 Then
        bTrapped = False
        Set cel = targ.Cells(1, 1)
            'Allow 1 second for user to complete a rightclick or doubleclick before trapping leftclick
        Application.OnTime Now + 1 / 86400, "Sheet1.DelayedWatch"       'Note that Sheet1 is codename for worksheet (not tabname)
    End If
End If
End Sub

Private Sub DelayedWatch()
If bTrapped = False Then
    MsgBox "Leftclick at " & cel.Address
End If
End Sub

Answer 3

我知道这个答复是迟了多年但是要取消一个事件，以防止发生另一个事件（在同一事件上）（即，当你双击时阻止单击发生）执行以下操作;

Private Sub CheckBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

        'Do your stuff in here to handle the doubleClick event

        Cancel = True 'send back a true boolean to cancel the singleClick

End Sub