使用粘貼按鈕打開新的工作表

Question

我正在爲用戶點擊一個按鈕並填充一個新的工作表，其中將有另一個宏按鈕僅用作粘貼按鈕，並且用戶可以粘貼屏幕截圖無論他們複製了什麼。目前，用戶點擊名爲「添加屏幕截圖」的按鈕，並且輸入框將填充詢問用戶他們想要命名屏幕截圖工作表。用戶在標題中書寫，並且新標籤與工作表的名稱一起形成爲用戶的輸入標題。下面是代碼這樣做：

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 

問題是我不知道如何將這兩段代碼鏈接在一起，以便當用戶輸入工作表標題並單擊確定時，新工作表將填充一個宏按鈕，該按鈕將運行上面的粘貼子例程。關於鏈接這兩者的任何建議，以及在用戶單擊確定以創建新工作表時使粘貼子運行？

謝謝。

Answer 1

您可以在運行時創建按鈕。

使用此方法，可以在創建工作表時以編程方式添加按鈕。

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 

所以你的全代碼應該是這個樣子：名稱= Title`行，您可以：

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