Option
Explicit
Sub
Example()
Dim
shp
As
Shape
With
ActiveSheet.Shapes
Set
shp = .AddFormControl(XlFormControl.xlButtonControl, 10, 10, 150, 80)
shp.Name =
"MyButton1"
shp.OLEFormat.
Object
.Caption = shp.Name
shp.OnAction =
"OnBtnClick"
Set
shp = .AddFormControl(XlFormControl.xlButtonControl, shp.Left, shp.Top + shp.Height + 5, 150, 80)
shp.Name =
"MyButton2"
shp.OLEFormat.
Object
.Caption = shp.Name
shp.OnAction =
"OnBtnClick"
Set
shp = .AddFormControl(XlFormControl.xlButtonControl, shp.Left, shp.Top + shp.Height + 5, 150, 80)
shp.Name =
"TheBlackSheep"
shp.OLEFormat.
Object
.Caption = shp.Name
shp.OnAction =
"OnBtnClick"
Set
shp = .AddFormControl(XlFormControl.xlButtonControl, shp.Left, shp.Top + shp.Height + 5, 150, 80)
shp.Name =
"MyButton3"
shp.OLEFormat.
Object
.Caption = shp.Name
shp.OnAction =
"OnBtnClick"
End
With
End
Sub
Public
Sub
OnBtnClick()
If
0 <> StrComp(TypeName(Application.Caller),
"String"
, vbTextCompare)
Then
Exit
Sub
End
If
Dim
shp
As
Excel.Shape
Set
shp = ActiveSheet.Shapes(Application.Caller)
If
shp.Type <> MsoShapeType.msoFormControl
Then
Exit
Sub
If
shp.FormControlType <> XlFormControl.xlButtonControl
Then
Exit
Sub
Select
Case
shp.Name
Case
"MyButton1"
,
"MyButton2"
Call
MsgBox(shp.Name &
": Muuuh!"
, vbInformation)
Case
"MyButton3"
Call
MsgBox(shp.Name &
": Määäääääh!"
, vbInformation)
Case
Else
Call
MsgBox(
"UNHANDLED CALL"
& vbNewLine & _
"Button: '"
& shp.Name &
"'"
& vbNewLine & _
"Routine: 'OnBtnClick'"
, _
vbExclamation)
Exit
Sub
End
Select
End
Sub