how to create button and button action in VBA automatically

L

luolovepi

Board Regular
Joined
Jun 9, 2011
Messages
116
I have some buttons in my worksheet.And all those buttons will do the same action. Since I will also dynamically create even more buttons using VBA during runtime, is there any way to create the actions for them without typing for example "Private Sub Line15_Click() SendData (15)" manually? I mean I want to add the action to the button at the same time the button is created.

Thank you~~~

The example of the current button action is as below.
Code: 
Private Sub Line15_Click()
    SendData (15)
 
End Sub
Private Sub Line16_Click()
    SendData (16)
 
End Sub
Private Sub Line17_Click()
    SendData (17)
 
End Sub
Private Sub Line18_Click()
    SendData (18)

Yours sincerely,
lolo
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
I have figured it out!
Code: 
Sub AddButton()
    Dim newButton As OLEObject
    With ActiveCell
        Set newButton = ActiveSheet.OLEObjects.Add _
            (ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=.Left, _
            Top:=.Top, _
            Height:=.Height, _
            Width:=.Width)
        newButton.Object.Caption = .Row
        newButton.Object.Font.Size = 6
        newButton.Object.Font.Bold = True
        newButton.Object.WordWrap = True
        newButton.Name = "Line" & .Row
        newButton.Object.Font.Name = "MS Gothic"
    End With
     ' Inserts code for the button
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub " & newButton.Name & "_Click()"
        .InsertLines Line + 2, "sendData(" & ActiveCell.Row & ")"
        .InsertLines Line + 3, "End Sub"
    End With
End Sub
 
Upvote 0
I have figured it out!
Code: 
Sub AddButton()
    Dim newButton As OLEObject
    With ActiveCell
        Set newButton = ActiveSheet.OLEObjects.Add _
            (ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=.Left, _
            Top:=.Top, _
            Height:=.Height, _
            Width:=.Width)
        newButton.Object.Caption = .Row
        newButton.Object.Font.Size = 6
        newButton.Object.Font.Bold = True
        newButton.Object.WordWrap = True
        newButton.Name = "Line" & .Row
        newButton.Object.Font.Name = "MS Gothic"
    End With
     ' Inserts code for the button
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub " & newButton.Name & "_Click()"
        .InsertLines Line + 2, "sendData(" & ActiveCell.Row & ")"
        .InsertLines Line + 3, "End Sub"
    End With
End Sub
 
Upvote 0
Instead of ActiveX controls you better create Forms controls. Procedures for them can be created before creating button and can be linked to button with only one line: btn.OnAction = "MySub". That's all.
 
Upvote 0
Wow, I'll have a try! Thank you so much~~~

Best regards,
lolo
Sektor said:
Instead of ActiveX controls you better create Forms controls. Procedures for them can be created before creating button and can be linked to button with only one line: btn.OnAction = "MySub". That's all.
Click to expand...
 
Upvote 0
Example.

In worksheet module:
Code: 
[COLOR="Blue"][COLOR="Blue"]Sub[/COLOR][/COLOR] AddDropDown()

    [COLOR="Blue"][COLOR="Blue"]Dim[/COLOR][/COLOR] dd [COLOR="Blue"][COLOR="Blue"]As[/COLOR][/COLOR] DropDown
    
    [COLOR="Blue"]With[/COLOR] ActiveCell
        [COLOR="Blue"][COLOR="Blue"]Set[/COLOR][/COLOR] dd = ActiveSheet.DropDowns.Add(.Left, .Top, .Width, .Height)
    [COLOR="Blue"][COLOR="Blue"]End[/COLOR][/COLOR] [COLOR="Blue"]With[/COLOR]
    
    [COLOR="Blue"]With[/COLOR] dd
        .AddItem "Item 1"
        .AddItem "Item 2"
        .AddItem "Item 3"
        .OnAction = "ItemSelection"
    [COLOR="Blue"][COLOR="Blue"]End[/COLOR][/COLOR] [COLOR="Blue"]With[/COLOR]

[COLOR="Blue"][COLOR="Blue"]End[/COLOR][/COLOR] [COLOR="Blue"][COLOR="Blue"]Sub[/COLOR][/COLOR]

[COLOR="Blue"][COLOR="Blue"]Private[/COLOR][/COLOR] [COLOR="Blue"][COLOR="Blue"]Sub[/COLOR][/COLOR] ItemSelection()
    [COLOR="Blue"]With[/COLOR] ActiveSheet.DropDowns(Application.Caller)
        .TopLeftCell = .List(.ListIndex)
        .Delete
    [COLOR="Blue"][COLOR="Blue"]End[/COLOR][/COLOR] [COLOR="Blue"]With[/COLOR]
[COLOR="Blue"][COLOR="Blue"]End[/COLOR][/COLOR] [COLOR="Blue"][COLOR="Blue"]Sub[/COLOR][/COLOR]
 
Upvote 0
Wow Sektor, so nice!
Thank you so much!!! This is exactly what I want!

Best regards,
lolo^-^
Sektor said:
Example.

In worksheet module:
Code: 
[COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR] AddDropDown()
 
    [COLOR=blue][COLOR=blue]Dim[/COLOR][/COLOR] dd [COLOR=blue][COLOR=blue]As[/COLOR][/COLOR] DropDown
 
    [COLOR=blue]With[/COLOR] ActiveCell
        [COLOR=blue][COLOR=blue]Set[/COLOR][/COLOR] dd = ActiveSheet.DropDowns.Add(.Left, .Top, .Width, .Height)
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
 
    [COLOR=blue]With[/COLOR] dd
        .AddItem "Item 1"
        .AddItem "Item 2"
        .AddItem "Item 3"
        .OnAction = "ItemSelection"
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
 
[COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR]
 
[COLOR=blue][COLOR=blue]Private[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR] ItemSelection()
    [COLOR=blue]With[/COLOR] ActiveSheet.DropDowns(Application.Caller)
        .TopLeftCell = .List(.ListIndex)
        .Delete
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR]
Click to expand...
 
Upvote 0
Oops. I misleaded you. Here's correct code (double-click a cell):

1. In worksheet module.
Code: 
[COLOR="Blue"]Private[/COLOR] [COLOR="Blue"]Sub[/COLOR] Worksheet_BeforeDoubleClick([COLOR="Blue"]ByVal[/COLOR] Target [COLOR="Blue"]As[/COLOR] Range, Cancel [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Boolean[/COLOR])
    [COLOR="Blue"]Call[/COLOR] AddDropDown
    Cancel = [COLOR="Blue"]True[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

2. In standard module.
Code: 
[COLOR="Blue"]Sub[/COLOR] AddDropDown()

    [COLOR="Blue"]Dim[/COLOR] dd [COLOR="Blue"]As[/COLOR] DropDown
    
    [COLOR="Blue"]With[/COLOR] ActiveCell
        [COLOR="Blue"]Set[/COLOR] dd = ActiveSheet.DropDowns.Add(.Left, .Top, .Width, .Height)
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]
    
    [COLOR="Blue"]With[/COLOR] dd
        .AddItem "Item 1"
        .AddItem "Item 2"
        .AddItem "Item 3"
        .OnAction = "ItemSelection"
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]

[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

[COLOR="Blue"]Private[/COLOR] [COLOR="Blue"]Sub[/COLOR] ItemSelection()
    [COLOR="Blue"]With[/COLOR] ActiveSheet.DropDowns(Application.Caller)
        .TopLeftCell = .List(.ListIndex)
        .Delete
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]
 
Upvote 0
Hi Sektor,
I created a new workbook and copied your code into VBA. But there is a error message says"Cannot run macro. The macro may not be available in this workbook or all macros may be disabled."
What's wrong with it? And what does the sub "ItemSelection" do?

Best regards,
lolo
Sektor said:
Example.

In worksheet module:
Code: 
[COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR] AddDropDown()
 
    [COLOR=blue][COLOR=blue]Dim[/COLOR][/COLOR] dd [COLOR=blue][COLOR=blue]As[/COLOR][/COLOR] DropDown
 
    [COLOR=blue]With[/COLOR] ActiveCell
        [COLOR=blue][COLOR=blue]Set[/COLOR][/COLOR] dd = ActiveSheet.DropDowns.Add(.Left, .Top, .Width, .Height)
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
 
    [COLOR=blue]With[/COLOR] dd
        .AddItem "Item 1"
        .AddItem "Item 2"
        .AddItem "Item 3"
        .OnAction = "ItemSelection"
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
 
[COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR]
 
[COLOR=blue][COLOR=blue]Private[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR] ItemSelection()
    [COLOR=blue]With[/COLOR] ActiveSheet.DropDowns(Application.Caller)
        .TopLeftCell = .List(.ListIndex)
        .Delete
    [COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue][COLOR=blue]End[/COLOR][/COLOR] [COLOR=blue][COLOR=blue]Sub[/COLOR][/COLOR]
Click to expand...
 
Upvote 0
Did you insert all subs into appropriate modules? Worksheet_BeforeDoubleClick must be in the sheet module, and AddDropDown and ItemSelection - in standard module.
When you double-click a cell, Worksheet_BeforeDoubleClick calls AddDropDown procedure. It creates DropDown and fills it with some values with AddItem method. Then by using OnAction property I tell DropDown to execute ItemSelection procedure when you choose any item from DropDown. When you selected item, ItemSelection procedure is executed. It enters selected item into cell which is beyond DropDown and deletes DropDown. So, your task is to fill DropDown with your values and decide what Sub to execute with OnAction property.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Using VBA to retrieve specific pages from PDFs
Replies
1
Views
93
Big_Al_fae_the_rigs
B
E
  • Question Question
Opening a User Form from Custom Ribbon Button Run-time and Complie issues
Replies
3
Views
468
Micron
M
W
  • Question Question
Creating a 'Reset' button for a text form, plus additional buttons
Replies
2
Views
222
WEB78
W
A
  • Question Question
How do I create a reset button that unchecks checkboxes in my spreadsheet - but not all of them?
Replies
6
Views
161
dmt32
D
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
71
Denny57
D

Forum statistics

Threads
1,223,767
Messages
6,174,390
Members
452,561
Latest member
amir5104

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top