Open new Worksheet with Paste Button - vba

Question

I am working on a macro for a user to click a button and populate a new worksheet where there will be another macro button solely functioning as a PASTE button would, and the user can paste the screenshot with whatever they have copied. Currently, the user clicks a button named "add screen shot", and a input box will populate asking the user what they would like to name the screen shot worksheet. The user writes in a title and a new tab is formed with the name of the worksheet as the user's inputted title. Here is the code to do so:
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
I already have the subroutine that pastes the clipboard image into the active cell within the open sheet:
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
The issue is I do not know how to link these two snippets of code together, so that when the user enters the title of the sheet and clicks OK, the new sheet populates with a macro button that will run the paste subroutine above. Any suggestions on linking the two, and making the paste sub run when the user click OK to create a new worksheet?
Thanks.

Answer 1

You can create the button at at runtime.
Using this method, you programmatically add a button when the sheet is created.
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
So your full code should look something like this:
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