使用粘贴button打开新的工作表

我正在为一个macros用户点击一个button，然后填充一个新的工作表，在那里将会有另一个macrosbutton，就像一个PASTEbutton一样，用户可以用他们复制的任何东西粘贴屏幕截图。 目前，用户点击一个名为“添加屏幕截图”的button，一个input框将填充询问用户他们想要命名屏幕截图工作表。 用户在标题中书写，新标签形成工作表名称作为用户input的标题。 这是这样做的代码：

Sub AddScreenShot() Dim Title As Variant Title = Application.InputBox("Enter a Title: ", "Add Screen Shot", , 400, 290, , , Type:=2) If Title = False Then Exit Sub ElseIf Title = vbNullString Then MsgBox "A title was not entered. Please enter a Title" Exit Sub ElseIf Len(Title) > 15 Then MsgBox "No more than 15 characters please" Run "AddScreenShot" Else ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = Title End If End Sub 

我已经有了将剪贴板图像粘贴到打开表单中的活动单元格的子例程：

 Sub Paste_Image() On Error GoTo PasteError Application.ScreenUpdating = False Range("E5").Activate ActiveSheet.Paste Application.ScreenUpdating = True ActiveSheet.Unprotect Password:=xxxx GetOutOfHere: Exit Sub PasteError: MsgBox "Please verify that an image has been copied", vbInformation, "Paste Image" Resume GetOutOfHere End Sub 

问题是我不知道如何将这两个代码片段链接在一起，以便当用户input表格的标题并单击确定时，新工作表将填充一个macrosbutton，该button将运行上面的粘贴子例程。 任何关于链接这两个build议，并使用户点击确定创build一个新的工作表时，粘贴子运行？

谢谢。

Answer 1

您可以在运行时创buildbutton。

使用这种方法，您可以在创build工作表时以编程方式添加一个button。

 Dim btn As Button Application.ScreenUpdating = False Dim t As Range Dim sht As Sheet 'Added to ensure we don't add duplicate sheets Set t = ActiveSheet.Range(Cells(1, 1)) Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height) With btn .OnAction = "Paste_Image" 'Calls the Paste_Image subroutine when clicked .Caption = "Paste" 'Change caption as you see fit .Name = "btnPaste" 'Change name as you see fit End With Next i Application.ScreenUpdating = True 

所以你的完整代码应该是这样的：

 Sub AddScreenShot() Dim Title As Variant Dim btn As Button Dim t As Range Dim sht As Worksheet Title = Application.InputBox("Enter a Title: ", "Add Screen Shot", , 400, 290, , , Type:=2) If Title = False Then Exit Sub ElseIf Title = vbNullString Then MsgBox "A title was not entered. Please enter a Title" Exit Sub ElseIf Len(Title) > 15 Then MsgBox "No more than 15 characters please" Run "AddScreenShot" Else On Error Resume Next Set sht = ActiveWorkbook.Worksheets(Title) On Error GoTo 0 If Not sht Is Nothing Then MsgBox "A worksheet named " & Title & " already exists!" Run "AddScreenShot" Else Application.ScreenUpdating = False ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Title Set t = ActiveSheet.Range("A1:B2") 'Button will appear in cell A1:B2, change to whatever you want. Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height) 'This will make the button the size of the cell, may want to adjust With btn .OnAction = "Paste_Image" 'Calls the Paste_Image subroutine when clicked .Caption = "Paste" 'Change caption as you see fit .Name = "btnPaste" 'Change name as you see fit End With Application.ScreenUpdating = True End If End If End Sub