DblClick FormButton

[pwill]

Hi can anyone help?

I have a form button that when clicked adds rows of data to sheet1. Is it possible to have this button add the rows with a single click as it does now but if double clicked add some text in cell A1 ie "ABC" without adding the rows at the same time?

any help would be appreciated

regards

pwill

 

[Kenneth Hobson]

Use an ActiveX control...

 

[Jaafar Tribak]

Differenciating between a Click and a Double-Click is not as easy as one might think even when usig ActiveX buttons .

If you try the following code for an ActiveX commandButton , you will see that the Double-Click Msgbox never shows up because the Click event always fires first when double-clicking:

Private Sub CommandButton1_Click()
    MsgBox "Click"
End Sub

Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MsgBox "Double-Click"
End Sub

I have seen workarounds but they all use the End statement to make it work which is problematic as the End statement inadvertently releases all the variables in the project.

The code I prefer using is API based .. It is more involved but doesn't require the use of the End Statement.

Assign the Click_DBLClick Routine to a Button or shape and place the code in a Standard Module :

Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
        
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
            Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
            Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
        Private Declare PtrSafe Function GetDoubleClickTime Lib "user32" () As Long
        Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
        Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
        Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
        Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
        
        Private lTimer As LongPtr
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
     Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Function GetDoubleClickTime Lib "user32" () As Long
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
     
    Private lTimer As Long
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const PM_REMOVE As Long = &H1
Private Const WM_LBUTTONDBLCLK = &H203

Private bSingleClick As Boolean

Public Sub Click_DBLClick()
    Dim tMsg As MSG
    
    SetTimer Application.hwnd, 0, 0, AddressOf HelperRoutine
    lTimer = GetTickCount
    Do
        WaitMessage
        If PeekMessage _
        (tMsg, 0, _
        WM_LBUTTONDBLCLK, WM_LBUTTONDBLCLK, PM_REMOVE) Then
            KillTimer Application.hwnd, 0
            Call DBLClickMacro
            Exit Sub
        End If
    Loop While GetTickCount - lTimer < GetDoubleClickTime
    bSingleClick = True
End Sub

Private Sub HelperRoutine()
    If bSingleClick Then
        bSingleClick = False
        KillTimer Application.hwnd, 0
        Call ClickMacro
    End If
End Sub

Private Sub ClickMacro()
    MsgBox "Click"
End Sub

Private Sub DBLClickMacro()
    MsgBox "DoubleClick"
End Sub

 

[mikerickson]

You want a single click to add row(s) and a double click to add rows and put text in some of those cells.

Get a Button from the Forms menu and attach it to this macro.

Sub Button1_Click()
    Static LastClick As Double
    
    With ActiveCell.EntireRow
        If 0.5 < (Timer - LastClick) Then
            Rem first click
            .Insert shift:=xlDown
        Else
            Rem doubled click
            .Cells(1, 1).Value = "double clicked"
        End If
    End With
    LastClick = Timer
End Sub

Note if the user double clicks, both branches of will be exicuted.

 

[pwill]

Thank you for your solutions, looks a bit too complicated for me, so I think I will try and find another solution.

much appreciated

pwill

 

[pwill]

You want a single click to add row(s) and a double click to add rows and put text in some of those cells.

Get a Button from the Forms menu and attach it to this macro.

Sub Button1_Click()
    Static LastClick As Double
    
    With ActiveCell.EntireRow
        If 0.5 < (Timer - LastClick) Then
            Rem first click
            .Insert shift:=xlDown
        Else
            Rem doubled click
            .Cells(1, 1).Value = "double clicked"
        End If
    End With
    LastClick = Timer
End Sub

Note if the user double clicks, both branches of will be exicuted.

Had a play around with this code and managed to get what I need. Thank you

mikerickickson

​

[FONT=Verdana]Sub Btn_Click()[/FONT]
[FONT=Verdana]    Static LastClick As Double
    
        With Range("A3").EntireRow 'Button is on "A3"
            If 0.5 < (Timer - LastClick) Then
                Rem first click
                Range("A7") = "" 'Single Click Clears Cell "A7"
            Else
                Rem doubled click
                .Cells(5, 1).Value = "B" 'Double Click Button to Add "B" to "A7"
            End If
        End With
        LastClick = Timer
    
End Sub[/FONT]

Regards

pwill