單擊命令按鈕宏

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）.Select，這將導致“運行時錯誤'13'：類型不匹配”。

任何幫助將不勝感激，謝謝！

Answer 1

右鍵單擊按鈕->查看代碼->將JobButton代碼放在​​此處