如何在Userform VBA中使用动态按钮

时间:2017-08-02 19:02:57

标签: excel vba excel-vba userform

我真的可以在这方面使用一些帮助。我已经阅读了大约60多个网站,它们要么不点击(双关语),要么我的申请不正确。这就是破败:

目标:使用"提交"在Userform中动态创建的按钮,用于将Caption从OptionButton复制到工作表上的动态单元格,然后清除/关闭Userform。

背景:通过工作表中列的更改来调用userform。 这是用于调用userform的代码片段:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lastRow As Long

    With Worksheets("Test")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("B1:B" & lastRow), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, 1).ClearContents
            Else
                With .Offset(0, 1)
                    .NumberFormat = "mmm dd yyyy hh:mm:ss"
                    .Value = Now
                    UserForm1.Show
                End With
            End If
            Application.EnableEvents = True
        End If
    End With

End Sub

显示Userform后,它会初始化。它从电子表格中的列表中提取,以填充有多少选项按钮,其标题以及Userform上每个项目的尺寸。代码是这样的:

Sub UserForm_Initialize()

Dim HLastRow As Integer
Dim NoOfExplanations As Integer
Dim TopPixels As Integer
Dim UserFormHeight As Integer
Dim UserFormWidth As Integer
Dim Opt As Variant
Dim i As Integer
Dim ExplanationRow As Integer
Dim lbl As MSForms.Label
Dim LabelCap As String
Dim btn As CommandButton
Dim OtherInput As MSForms.TextBox
Dim Margins As Integer

    With Worksheets("Test")
        HLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
    End With

NoOfExplanations = Application.WorksheetFunction.CountA(Worksheets("Test").Range("H2:H" & HLastRow))
Margins = 20

LabelCap = "You have chosen a non sequential row for your team/subteam. Please select an explanation below before you are able to proceed"
UserFormWidth = Len(LabelCap) * 2
TopPixels = (18 * 2)
UserFormHeight = TopPixels + 80 + (20 * NoOfExplanations)

    With UserForm1
        .Width = UserFormWidth + 40
        .Height = UserFormHeight
    End With

    Set lbl = UserForm1.Controls.Add("Forms.Label.1")
    With lbl
        .Top = 10
        .Left = 20
        .Height = 20
        .Width = UserFormWidth - 20
        .Caption = LabelCap
    End With

ExplanationRow = 2
For i = 1 To NoOfExplanations

    Set Opt = UserForm1.Controls.Add("Forms.OptionButton.1", "OptionButton" & i, True)

    Opt.Caption = Worksheets("Test").Cells(ExplanationRow, 8).Value

    If Worksheets("Test").Cells(ExplanationRow, 8).Value = "Other" Then
        Set OtherInput = UserForm1.Controls.Add("Forms.TextBox.1")
        With OtherInput
            .Top = TopPixels
            .Width = UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11)
            .Left = UserFormWidth - (UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11))
            .Height = 18
        End With
    End If

    If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) > 45 Then
        Opt.Width = UserFormWidth - 10
        Opt.Height = 36
        Opt.Left = 18

        Opt.Top = TopPixels
        TopPixels = TopPixels + 38
    End If

    If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) <= 45 Then
        Opt.Width = UserFormWidth - 10
        Opt.Height = 18
        Opt.Left = 18

        Opt.Top = TopPixels
        TopPixels = TopPixels + 20
    End If
    ExplanationRow = ExplanationRow + 1
Next i

    Set btn = UserForm1.Controls.Add("Forms.CommandButton.1")
    With btn
        .Top = TopPixels
        .Width = 40
        .Left = ((UserFormWidth + 40) / 2) - 20
        .Height = 20
        .Caption = "Submit"
        .Name = btn
    End With
End Sub

问题:那么,如何在Userform中创建btn,将选定的OptionButton标题复制到动态单元格,然后清除/关闭Userform?

我知道这是一段时间,但是我试图填补距离&#34;目标&#34;两个列的单元格。触发Userform打开的单元格。代码在剪切的Worksheet_Change中填充.Offset(0,1)中的当前日期/时间,但有没有办法将OptionButton标题放在单元格中.Offset(0,2)?

我对VBA还很陌生,这件事真的让我感到刺痛。

我对这方面的任何帮助都非常感激。

谢谢! 乔

1 个答案:

答案 0 :(得分:1)

btn变量更改为类级变量并使用WithEvents将允许您访问动态按钮事件。

Private WithEvents btn As CommandButton

Private Sub btn_Click()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "OptionButton" Then
            If ctrl.Object.Value Then
                MsgBox ctrl.Object.Caption
            End If
        End If
    Next
End Sub

enter image description here