CODEWITHSUNDEEP
vbaexcelbutton
vlad.lisnyi
vlad.lisnyi

Reputation: 345

Automatically inserted button and Macro assigned to it not working properly

The code I have written automatically put the button where needed and assign a macro to it:

Sub CreateButton(a, b, c, d As Double, s As String)
ActiveSheet.Buttons.Add(a, b, c, d).Select
Selection.name = s
Selection.OnAction = "Button_ACTION"
Selection.Characters.Text = s
End Sub

The whole macro proceed as follow, firstly delete all buttons on the sheet, than it insert buttons where needed and assign macro to it:

Private Sub Button_ACTION()
Dim o As Object
Dim r, i, c As Integer
Set o = ActiveSheet.Buttons(Application.Caller)
With o.TopLeftCell
    r = .Row
    c = .Column
End With
...

Macro determines the position of button and manipulate data around. The problem is that no matter which button I am clicking the data changes only around the first one in the column. Please, advise what is the problem and what can be the solution?

Upvotes: 1

Views: 1053

Answers (3)

CommonSense
CommonSense

Reputation: 4482

First of all - try not to use selection!

Second - why you need thoose integers? Use Longs!

Your problem (I assume) is because of you give same name over and over, so with Set o = ActiveSheet.Buttons(Application.Caller) line you pick your first button with given name!

Since you don't mentioned where(and how) your function-like sub CreateButton are called from there's only one way to reproduct your problem for me - calling sub multiple time with same s parameter.

Note: Application.Caller is a string with name of a button in your case.

Try to give something unique!

Sub CreateButton(a, b, c, d As Double, s As String)
    Dim NewButton As Button
    Static Counter As Long

    Set NewButton = ActiveSheet.Buttons.Add(a, b, c, d)
    NewButton.Name = s & Counter
    NewButton.OnAction = "Button_ACTION"
    NewButton.Characters.Text = s
    Counter = Counter + 1
End Sub

But I suggest that you work on the uniqueness of your names. Static counter is ok if you are not a perfectionist, you are good with Long type limitations and all of your buttons are deleted upon quiting excel.

I advise you not to hope for it - when you need something unique - always use dictionary.

With dictionary it's easy to answer a question "Is that string are really unique?":

Public Function IsUnique(ByVal str As String) As Boolean
    Static UniqueDict As New Dictionary

    If UniqueDict.Exists(str) Then _
            Exit Function

    Call UniqueDict.Add(Key:=str, Item:=str)
    IsUnique = True
End Function

So you can edit string or add something to it only when it's really necessary. And if you don't bother deleting buttons upon quit - you can fill that dict with names on startup! Marvelous isnt it?

To use a dictionary object you need reference to Microsoft Scripting Runtime!

Upvotes: 1

Cheries Mewengkang
Cheries Mewengkang

Reputation: 76

why do you use Application.Caller on your code...? will it return the caller Shape object..? Try to debug it...., I think Application.Caller will fail to return the caller Shape (the Shape object where your macro assigned). You can give a unique name for each Shapes object you've created and access it by its name, here an example hope it useful.

Option Explicit

    Public Sub AddButtonWithLoop()
        Dim btn As Shape
        'Use for each loop to Create 3 Shapes, assign name and macro to each Shape
        Dim i As Integer
        For i = 1 To 3
            Set btn = Worksheets(1).Shapes.AddShape(msoShapeBevel, 10, 70 * i, 70, 50)
            'set some properties
            With btn
            .Name = "MyButton" & i
            .TextFrame2.TextRange.Characters.Text = "Button " & i
            .OnAction = "'SayHello""" & btn.Name & """'"
        End With
    Next i
End Sub

Public Sub SayHello(shapeName As String)
    'Create Shape object using ShapeName
    Dim s As Shape: Set s = ActiveSheet.Shapes(shapeName)

    With s.TopLeftCell
        MsgBox .Row
        MsgBox .Column
    End With
End Sub

Upvotes: 0

Pᴇʜ
Pᴇʜ

Reputation: 57673

The issue is that you don't have unique names for your buttons.

I changed your CreateButton() sub so it can take a name and a caption as parameter. Name is what Application.Caller uses and caption is what is written on the button. Name must be unique, caption can be the same on all buttons.

I also added a check so that only unique button names are accepted on creation.

Sub test()
    CreateButton 200, 100, 100, 25, "test1", "Test"
    CreateButton 50, 50, 100, 25, "test2", "Test"
    CreateButton 500, 500, 100, 25, "test3", "Test"
End Sub


Sub CreateButton(left As Double, top As Double, width As Double, height As Double, name As String, caption As String)
    On Error Resume Next
        ActiveSheet.Buttons(name).name = name
        If Err.Number = 0 Then
            MsgBox "Name has to be unique"
            Exit Sub
        End If
    On Error GoTo 0
    'this part above assures that the name for the button is unique.

    With ActiveSheet.Buttons.Add(left, top, width, height)
        .name = name
        .caption = caption
        .OnAction = "Button_ACTION"
    End With
End Sub

I highly recommend using readable variable names instead of a, b, c and o!

And be aware that

Dim r, i, c As Integer 'r and i are of type variant here only c is integer

CreateButton(a, b, c, d As Double, s As String)
'a, b and c are of type variant. Only d is double and s is string.

is not the same as 

Dim r As Integer, i As Integer, c As Integer

CreateButton(a As Double, b As Double, c As Double, d As Double, s As String)

Upvotes: 1

Related Questions