Reputation: 41
I'm trying to get a single macro that I can assign to my command buttons. I have multiple buttons that open different files so in each cell I include a different file path.
Currently my command buttons are looking for a specific cell reference and opening that value. Is there any way I can get the macro to look for the value in the cell to which it is aligned?
I'm using two macros at the moment - one to create the buttons and then another to assign to the buttons. I am having to create a new macro for each button.
Macro to create button...
Sub Buttons()
Dim i As Long
Dim lRow2 As Integer
Dim shp As Object
Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHeight As Double
With Sheets("Print Schedule")
dblLeft = .Columns("A:A").Left 'All buttons have same Left position
dblWidth = .Columns("A:A").Width 'All buttons have same Width
For i = Range("E65536").End(xlUp).Offset(1, 0) To ActiveCell + 15
dblHeight = .Rows(i).Height 'Set Height to height of row
dblTop = .Rows(i).Top 'Set Top top of row
Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
shp.Characters.Text = "Open Print Schedule"
Next i
End With
End Sub
Macros to open file...
Sub Mendip()
Dim myfile As String
myfile = Cells(6, 6).Value
Application.Workbooks.Open Filename:=myfile
End Sub
Please tell me there is a better way to do this!
Upvotes: 4
Views: 5833
Reputation: 149295
When you create the form buttons as shown below then you can assign a common macro to them
And you can assign a macro like this
Sub Sample()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
'MsgBox shp.TopLeftCell.Address
Select Case shp.TopLeftCell.Address
Case "$A$1"
'~~> Do Something
Case "$B$1"
'~~> Do Something
'
'~~> And So on
'
End Select
End Sub
EDIT:
One thing I forgot to mention. To assign the "Sample" macro to all buttons, Add the below line after you create the shape.
shp.OnAction = "Sample"
Upvotes: 3