При нажатии кнопки макроса

Question

Я пытаюсь создать макрос для командной кнопки, которая при нажатии получит номер задания из этой строки и ищет файл для этого задания.Если он не существует, я хочу скопировать его из шаблона и сохранить с новым именем, в противном случае просто откройте файл.

Однако я не могу понять, как получить информацию для командыкнопка, которая вызывает макрос.Это то, что я до сих пор:

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

Как вы можете видеть, я в настоящее время пытаюсь ActiveSheet.Shapes (Application.Caller). Выберите, это вызывает «Ошибка времени выполнения» 13: Типнесоответствие ".

Любая помощь будет высоко ценится, спасибо!

Answer 1

Щелкните правой кнопкой мыши по кнопке -> Показать код -> введите свой код JobButton здесь