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

右键单击按钮 - ＆gt;查看代码 - ＆gt;把你的JobButton代码放在这里

单击命令按钮宏

1 个答案: