On Click Command Button Macro
I'm trying to create a macro for a command button that when clicked, will get the job number from that row and look for a file for that job. If it does not exist I want it to copy from a template and save with a new name, otherwise just open the file.
However, I cannot seem to work out how to get hold of the information for the command button that calls the macro. This is what I have so far:
Public Function ShapeExists(OnSheet As Object, Name As String) As Boolean On Error GoTo ErrShapeExists If Not OnSheet.Shapes(Name) Is Nothing Then ShapeExists = True End If ErrShapeExists: Exit Function End Function Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim buttonName As String buttonName = (Target.Row - 1) If Not ShapeExists(ActiveSheet, buttonName) Then If Range("O" & Target.Row).Value = "" And Target.Column <= 14 And Target.Row > 1 Then ActiveSheet.Buttons.Add(910.5, Range("O" & Target.Row).Top, 80, 20).Select Selection.Name = buttonName Selection.OnAction = "Sheet1.JobButton" ActiveSheet.Shapes(buttonName).Select Selection.Characters.Text = "Open Job" End If End If End Sub Private Sub JobButton() Dim newText As String ActiveSheet.Shapes(Application.Caller).Select If Range("N" & Selection.TopLeftCell.Row).Value <> "" Then newText = "Job " & Range("N" & Selection.TopLeftCell.Row).Value Dim checkFilename As String Dim check As String check = "N" & Selection.TopLeftCell.Row checkFilename = newText & ".xlsm" If Dir(checkFilename) <> "" Then Workbooks.Open (newText) Else Dim SrcBook As Workbook Set SrcBook = ThisWorkbook Dim NewBook As Workbook NewBook = Workbooks.Open("Job Template.xlsm") SrcBook.Worksheets(1).Range("D" & Selection.TopLeftCell.Row).Copy NewBook.Worksheets(2).Range("B15").PasteSpecial With NewBook .Title = newText .Subject = newText .SaveAs Filename:=newText End With End If Else ErrMsg: MsgBox ("Job Should always have a number."), , "NO JOB NUMBER" End If End Sub
As you can see I am currently trying ActiveSheet.Shapes(Application.Caller).Select, this is causing a "Run-time error '13': Type mismatch".
Any help would be much appreciated, thank you!
Right-click the button --> View Code --> put your JobButton code here