[英]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". 如您所见,我当前正在尝试ActiveSheet.Shapes(Application.Caller).Select,这将导致“运行时错误'13':类型不匹配”。
Any help would be much appreciated, thank you! 任何帮助将不胜感激,谢谢!
右键单击按钮->查看代码->将JobButton代码放在此处
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.