Ein Klicken Sie auf Befehlsschaltfläche Makro

Question

Ich versuche, ein Makro für eine Befehlsschaltfläche zu erstellen, die nach dem Klicken die Auftragsnummer aus dieser Zeile abrufen und nach einer Datei für diesen Auftrag suchen. Wenn es nicht existiert, möchte ich, dass es von einer Vorlage kopiert und unter einem neuen Namen gespeichert wird, ansonsten öffne einfach die Datei.

Allerdings kann ich nicht herausfinden, wie die Informationen für die Befehlsschaltfläche abgerufen werden, die das Makro aufruft. Das ist, was ich habe, so weit:

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 

Wie Sie mir gerade sehen ActiveSheet.Shapes (Application.Caller) .Select versucht, dies einen „Laufzeitfehler‚13‘: Typenkonflikt“ verursacht .

Jede Hilfe wäre sehr geschätzt, danke!

Answer 1

Rechtsklick auf die Schaltfläche -> Code anzeigen -> hier setzen Sie Ihre JobButton Code