Question

我正在开发一个宏，供用户点击一个按钮并填充一个新的工作表，其中将有另一个宏按钮单独用作PASTE按钮，用户可以将屏幕截图粘贴到他们复制的任何内容。目前，用户单击名为＆＃34的按钮;添加屏幕截图＆＃34;，并且将输入一个输入框，询问用户他们想要命名屏幕截图工作表的内容。用户在标题中写入，并且用工作表的名称形成新标签作为用户输入的标题。这是代码：

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

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

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

使用粘贴按钮打开新工作表

1 个答案: