如何将单元格链接到动态创建的用户表单复选框。

Question

我在这个问题上尝试了一个多星期，但仍然没有弄清楚，我们的截止日期是 3 天。所以我们可以在下面看到我根据特定的单元格范围动态创建了这个用户表单复选框。

但是，每当复选框为真或复选框列表为真时，它会在工作表中找到该复选框的标题名称并偏移 4 行；新单元格中的值用于然后在新单元格中找到平均值。我看过很多似乎不适合这个问题的视频和博客。

我更习惯于 C/C++、Python。 VBA excel 对我来说有点新，故障排除有点困难。

**********************************代码1************ *************************

Private Sub AddCheckbox()

 Dim Rows As Integer
 Dim toppart As Integer
 Dim Opt As Variant
 Dim x As Integer

 On Error Resume Next
 toppart = 20

UpdateRow = Application.WorksheetFunction.CountA(ActiveSheet.Range("C:ZU"))

For x = 3 To UpdateRow

    Set Opt = Te.Controls.Add("Forms.CheckBox.1", "CheckBox" & x, True)

   Opt.Caption = ActiveSheet.Cells(3, x).Value


    Opt.Width = 70
    Opt.Height = 18
    Opt.Left = 18

    Opt.Top = toppart
    toppart = toppart + 20
    Next

End Sub

************************************代码2*************** *************************

Private Sub Average()

Dim Ctrl As Object
Dim R As Range
Dim key As Integer

For Each Ctrl In Te.Controls
    If TypeName(Ctrl) = "Checkbox" Then
        If Ctrl.Value = True Then

         key = ActiveSheet.Cells(3, x).Value
        Set R = Range("C3:CU3").Find(What:=key)
    End If
        End If
Next


End Sub

任何帮助将不胜感激。

Answer 1

你可以用这个来创建复选框：

Dim sh As Worksheet
Dim lRow As Long
Dim shp As Shape
Dim rng As Range

Set sh = ThisWorkbook.Sheets("Plan1")
lRow = sh.Range("C" & Rows.Count).End(xlUp).Row

For Each rng In sh.Range("C3:C" & lRow)
    Set shp = sh.Shapes.AddFormControl(xlCheckBox, Left:=rng.Offset(0, -1).Left, Top:=rng.Offset(0, -1).Top, Width:=70, Height:=18)
    shp.Select
    With Selection
        .Caption = rng.Value
    End With
Next rng

然后，像这样选中每个复选框：

Dim sh As Worksheet
Dim shp As Shape
Dim key As String
Dim rng1 As Range
Dim rng2 As Range
Dim FindRange As Range
Dim lRow As Long

Set sh = ThisWorkbook.Sheets("Plan1")
lRow = sh.Range("C" & Rows.Count).End(xlUp).Row
Set rng1 = sh.Range("C3:C" & lRow)

For Each shp In sh.Shapes
    If InStr(shp.Name, "Check Box") <> 0 Then 'If is a check box then

        If shp.ControlFormat.Value = 1 Then 'If checkbox is checked

            key = shp.AlternativeText 'Get the name of the checkbox

            Set FindRange = rng1.Find(What:=key, LookIn:=xlValues) 'search in the rng1 that name

            If Not FindRange Is Nothing Then 'If found, then
                Set rng2 = FindRange.Offset(0, 4) 'save the range with 4 columns offset in rng2

                'do something

            End If

        End If

    End If
Next shp

不要忘记更改工作表的名称。