How to change colours on buttons

[123Maximus]

Hello Everybody!

I have a couple of 'buttons' to send a certain value to column A with.

Now I would like to change the colour and disable the button for let's say 0,5 seconds every time someone press it.
The reason is that it should be a confirmation and to prevent users from pressing it too many times in a row.


Sub Makro3()
' Sends the text that is on the button ????
'Find next available row in column A
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & r) = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Range("A" & r).Select
End Sub

Thanks in advance!

 

[tonyyy]

123Maximus,

You might consider the following...

Sub Makro3()
'Sends the text that is on the button ????
'Find next available row in column A

Dim r As Long
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & r) = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Range("A" & r).Select

With Application
    ActiveSheet.Shapes(.Caller).Visible = False
    .ScreenUpdating = True
    .Wait (Now + TimeValue("0:00:02"))
    ActiveSheet.Shapes(.Caller).Visible = True
    .ScreenUpdating = True
End With
End Sub

Rather than coloring and disabling the button, it's simply hidden.

Cheers,

tonyyy

 

[123Maximus]

Thanks Tonyy!

It works fine with your solution. However; if you tap the button multiple times when it's hidden it will still send values to column A.
People who are going to use this application can be very impatient...
(Btw I put red squares named "WAIT" behind every button).

 

[Yongle]

Why make life so complicated?

Add this as the last line of the macro, forces user to click "OK"

MsgBox "Row added", vbOKOnly, "Patience is a virtue"

 

[Yongle]

Rather than using Application.Wait....
- this approach checks the difference in time between button clicks
- if the time is too short then the text is not added to the next row

Sub Makro3()
    Dim r As Long, shp As Shape
    Static cTime, pTime
    pTime = cTime:  cTime = Now

    If cTime - pTime < 0.00001 Then
        MsgBox "Patience please"
        pTime = 0:  pTime = 0
        Exit Sub
    End If

    r = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With Range("A" & r)
        .Value = shp.TextFrame.Characters.Text
        .Select
    End With
End Sub

 

[123Maximus]

.

 

[123Maximus]

Thank you very much, it works perfect!