时间戳

首页 > 解决方案 > 如何根据excel VBA中的选择添加可选复选框

excel - 如何根据excel VBA中的选择添加可选复选框

问题描述

我正在写一个用户表单

我想要实现的目标：在运行带有多个选择复选框的用户表单时。

  1. 收集所有选中的复选框标题及其父框架名称
  2. 使用收集的字符串在其第一列过滤数据库
  3. 遍历过滤的单元格并进行所需的总和
  4. 选择可以包含具有不同列的每一行（基于复选框选择）

编码为估计命令按钮：

Private Sub preflight_calculate_Click()
    Dim preflight_resource As Double, preflight_time As Double

    preflight_resource = Val(Me.preflight_resource)
    preflight_time = Val(Me.preflight_time)
    Dim cell As Range
    With ThisWorkbook.Sheets("Preflight")
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            .AutoFilter 1, Criteria1:=GetCheckedCaptions, Operator:=xlFilterValues
            For Each cell In .SpecialCells(xlCellTypeVisible)
                preflight_resource = preflight_resource + cell.Offset(, 6).Value
                preflight_time = preflight_time + cell.Offset(, 8).Value
            Next
        End With
        .AutoFilterMode = False
    End With

    With Me
        .preflight_resource.Text = preflight_resource
        .preflight_time.Text = preflight_time
    End With
End Sub

Function GetCheckedCaptions() As Variant
    Dim ctl As Control
    With Me
        For Each ctl In .Controls
            If TypeName(ctl) = "CheckBox" Then
                If ctl.Value Then
                    GetCheckedCaptions = GetCheckedCaptions & " " & ctl.Parent.Caption & "-" & ctl.Caption
                End If
            End If
        Next
    End With
    GetCheckedCaptions = Split(Trim(GetCheckedCaptions))
End Function

错误代码行： 

preflight_resource = preflight_resource + cell.Offset(, 6).Value

用户窗体 UI

Excel表（数据库）

预期结果： 例如：

如果我选择如下复选框 US -> Mobile -> P0 和 US -> Desktop -> P1

输出应该是：

下面的文本框：

资源利用：(F2 + G3) -> (0.73 + 0.62) -> 1.35（在文本框内）

以小时为单位的时间：(H2 + I3) -> (5.87 + 4.95) -> 10.82（在文本框内）

如何做到这一点？

标签： excelvbauserform

解决方案

我有不同的方法来解决你的问题。

如果有一个单独的列来存储每个选择的值是一个选项，那么请检查一下。

电子表格中发生的情况摘要：

  • 复选框数据将通过 VBA 代码存储在 L 到 O 列中

  • 单元格 L25 和 N25 将通过添加公式（在每个单元格中）来汇总总资源和时间

    L25 -> =总和（L2:M23）

    N25 -> =总和（N2:O23）

您可以在这里下载当前文件：https ://1drv.ms/x/s!ArAKssDW3T7wlKMfhNyjEDsHmkxz-g

这将是设置

在此处输入图像描述

用户表单背后的代码如下。阅读每条评论对其进行自定义：

Option Explicit


Private Sub knightregression_yes_Change()

    Application.EnableEvents = False

    ' Record values according to checkboxes checked in form
    mUserForm.RecordCheckboxChange Me, Me.knightregression_yes, "Mobile", "Knight regression" ' In this case the task title is specified (last sub argument)

    Application.EnableEvents = True

End Sub

Private Sub preflight_no_Click()

    Application.EnableEvents = False

    ' Set userform's controls values depending on which one is calling the function
    SetUserFormControlsValues Me, Me.preflight_no

    Application.EnableEvents = True

End Sub



Private Sub preflight_yes_Click()

    Application.EnableEvents = False

    ' Set userform's controls values depending on which one is calling the function
    SetUserFormControlsValues Me, Me.preflight_yes

    Application.EnableEvents = True

End Sub

Private Sub us_desktop_Change()

    Application.EnableEvents = False

    ' Set userform's controls values depending on which one is calling the function
    SetUserFormControlsValues Me, Me.us_desktop

    Application.EnableEvents = True

End Sub

Private Sub us_dp0_Change()

    Application.EnableEvents = False

    ' Record values according to checkboxes checked in form
    mUserForm.RecordCheckboxChange Me, Me.us_dp0, "Desktop"

    Application.EnableEvents = True

End Sub

Private Sub us_mobile_Change()

    Application.EnableEvents = False

    ' Set userform's controls values depending on which one is calling the function
    SetUserFormControlsValues Me, Me.us_mobile

    Application.EnableEvents = True

End Sub

Private Sub us_mp0_Change()

    Application.EnableEvents = False

    ' Record values according to checkboxes checked in form
    mUserForm.RecordCheckboxChange Me, Me.us_mp0, "Mobile"

    Application.EnableEvents = True

End Sub

Private Sub us_mp1_Change()

    Application.EnableEvents = False

    ' Record values according to checkboxes checked in form
    mUserForm.RecordCheckboxChange Me, Me.us_mp1, "Mobile"

    Application.EnableEvents = True

End Sub

Private Sub us_mp2_Change()

    Application.EnableEvents = False

    ' Record values according to checkboxes checked in form
    mUserForm.RecordCheckboxChange Me, Me.us_mp2, "Mobile"

    Application.EnableEvents = True

End Sub

Private Sub us_yes_Change()

    Application.EnableEvents = False

    ' Set userform's controls values depending on which one is calling the function
    SetUserFormControlsValues Me, Me.us_yes

    Application.EnableEvents = True

End Sub

Private Sub UserForm_Initialize()

    Dim formControl As MSForms.Control

    ' Clear preflight selections
    ThisWorkbook.Worksheets("Preflight").Range("L2:O32").ClearContents

    ' Make all checkboxes unchecked and disabled except preflight test
    For Each formControl In Me.Controls

        If TypeOf formControl Is MSForms.CheckBox Then

            If InStr(formControl.Name, "preflight") = 0 Then
                formControl.Value = False
                formControl.Enabled = False
            End If

        End If

    Next

    ' Empty resource and time textboxes
    Me.preflight_resource = vbNullString
    Me.preflight_time = vbNullString

End Sub

Private Sub ComboBox2_Change()
Dim index As Integer
index = ComboBox2.ListIndex

lstAll.Clear
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Select Case index
    Case Is = 0
    With lstAll


           Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If


        End With
    Case Is = 1
        With lstAll
            .AddItem "No Task"
        End With
    Case Is = 2
        With lstAll
            .AddItem "No Task"
        End With
End Select

End Sub

Private Sub Newfeatureyes_Click()
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Dim i As Long, LastRow As Long
LastRow = Sheets("NewFeature").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("NewFeature").Cells(i, "A").Value
Next i
End If
End Sub

Private Sub Newfeatureno_Click()
lstAll.Clear
lst_Added.Clear
mobileutilize = ""
mobilehours = ""
desktoputilize = ""
desktophours = ""

End Sub





Private Sub submitmobile_Click()
   Dim i As Long, j As Long, LastRow As Long
   Dim lbValue As String
   Dim ws As Worksheet

   If lst_Added.ListCount = 0 Then
       MsgBox "Please add atleast 1 task"
       Exit Sub
   End If

   mobileutilize = ""
   mobilehours = ""

   Set ws = ThisWorkbook.Sheets("NewFeature")

   With ws
       LastRow = .Range("A" & Rows.Count).End(xlUp).Row

       For i = 2 To LastRow
           For j = 0 To lst_Added.ListCount - 1
               lbValue = lst_Added.List(j)

               If .Cells(i, "A").Value = lbValue Or _
                  .Cells(i, "A").Value = Val(lbValue) Then
                   mobileutilize = Val(mobileutilize) + Val(.Cells(i, "F").Value)
                   mobilehours = Val(mobilehours) + Val(.Cells(i, "H").Value)
               End If
           Next
       Next
   End With
End Sub


Private Sub submitdesktop_Click()
   Dim i As Long, j As Long, LastRow As Long
   Dim lbValue As String
   Dim ws As Worksheet

   If lst_Added.ListCount = 0 Then
       MsgBox "Please add atleast 1 task"
       Exit Sub
   End If

   desktoputilize = ""
   desktophours = ""

   Set ws = ThisWorkbook.Sheets("NewFeature")

   With ws
       LastRow = .Range("A" & Rows.Count).End(xlUp).Row

       For i = 2 To LastRow
           For j = 0 To lst_Added.ListCount - 1
               lbValue = lst_Added.List(j)

               If .Cells(i, "A").Value = lbValue Or _
                  .Cells(i, "A").Value = Val(lbValue) Then
                   desktoputilize = Val(desktoputilize) + Val(.Cells(i, "G").Value)
                   desktophours = Val(desktophours) + Val(.Cells(i, "I").Value)
               End If
           Next
       Next
   End With
End Sub


Private Sub cmdAdd_Click()
   If lstAll.ListCount = 0 Then
       MsgBox "Select an item"
       Exit Sub
   End If
Dim i As Integer
For i = 0 To lstAll.ListCount - 1
    If lstAll.Selected(i) = True Then lst_Added.AddItem lstAll.List(i)
Next i
End Sub
Private Sub cmdRemove_Click()

   If lstAll.ListCount = 0 Then
       MsgBox "Select an item"
       Exit Sub
   End If
Dim counter As Integer
counter = 0

For i = 0 To lst_Added.ListCount - 1
    If lst_Added.Selected(i - counter) Then
        lst_Added.RemoveItem (i - counter)
        counter = counter + 1
    End If
Next i
End Sub

Private Sub CommandButton1_Click()
Unload Me
Sheets("Estimation form").Select
Range("A1").Select
End Sub


Private Sub ComboBox1_DropButtonClick()
Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.ComboBox1.ListCount = 0 Then
For i = 2 To LastRow
Me.ComboBox1.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If
End Sub

另外，添加一个模块，将其命名为：mUserForm 并添加以下代码：

Option Explicit

' Set userform's controls values depending on which one is calling the function
Public Sub SetUserFormControlsValues(mainUserForm As UserForm1, sourceControl As MSForms.Control)

    Dim formControl As MSForms.Control

    Dim enableMainCheckBoxes As Boolean
    Dim enableMobileCheckBoxes As Boolean
    Dim enableDesktopCheckBoxes As Boolean
    Dim enableMPCheckboxes As Boolean
    Dim enableDPCheckboxes As Boolean

    Dim countryCode As String
    Dim subcontrolList() As String

    Dim counter As Integer

    Select Case sourceControl.Name

    ' If preflight yes or no
    Case "preflight_yes"
        enableMainCheckBoxes = True ' xx_yes
        enableMobileCheckBoxes = False ' xx_mobile
        enableDesktopCheckBoxes = False ' xx_desktop
        enableMPCheckboxes = False ' xx_mpx
        enableDPCheckboxes = False ' xx_dpx

        subcontrolList = Split("yes", ",")

    Case "preflight_no"
        enableMainCheckBoxes = False ' xx_yes
        enableMobileCheckBoxes = False ' xx_mobile
        enableDesktopCheckBoxes = False ' xx_desktop
        enableMPCheckboxes = False ' xx_mpx
        enableDPCheckboxes = False ' xx_dpx

        subcontrolList = Split("yes", ",")

    ' If main box yes
    Case "us_yes", "uk_yes", "jp_yes", "de_yes", "es_yes", "it_yes", "fr_yes"
        enableMainCheckBoxes = True ' xx_yes
        enableMobileCheckBoxes = sourceControl.Value ' xx_mobile
        enableDesktopCheckBoxes = sourceControl.Value ' xx_desktop
        enableMPCheckboxes = False ' xx_mpx
        enableDPCheckboxes = False ' xx_dpx

        countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)

        subcontrolList = Split("mobile,desktop", ",")

    ' If mobile yes
    Case "us_mobile", "uk_mobile", "jp_mobile", "de_mobile", "es_mobile", "it_mobile", "fr_mobile"
        enableMainCheckBoxes = True ' xx_yes
        enableMobileCheckBoxes = True ' xx_mobile
        enableDesktopCheckBoxes = True ' xx_desktop
        enableMPCheckboxes = True ' xx_mpx
        enableDPCheckboxes = False ' xx_dpx

        countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)

        subcontrolList = Split("mp", ",")

    ' if desktop yes
    Case "us_desktop", "uk_desktop", "jp_desktop", "de_desktop", "es_desktop", "it_desktop", "fr_desktop"
        enableMainCheckBoxes = True ' xx_yes
        enableMobileCheckBoxes = True ' xx_mobile
        enableDesktopCheckBoxes = True ' xx_desktop
        enableMPCheckboxes = False ' xx_mpx
        enableDPCheckboxes = True ' xx_dpx

        countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)

        subcontrolList = Split("dp", ",")

    End Select


    For Each formControl In mainUserForm.Controls

        If TypeOf formControl Is MSForms.CheckBox Then

            ' Set sub controls value
            For counter = 0 To UBound(subcontrolList)

                If sourceControl.Name = "preflight_yes" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                    formControl.Enabled = True
                    formControl.Value = False

                ElseIf sourceControl.Name = "preflight_no" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                    formControl.Enabled = False
                    formControl.Value = False

                ElseIf InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                    formControl.Enabled = sourceControl.Value
                    formControl.Value = False

                End If

            Next counter

        End If

    Next

    mainUserForm.releasenote_yes.Value = False
    mainUserForm.automationfail_yes.Value = False
    mainUserForm.knightregression_yes.Value = False

    mainUserForm.releasenote_yes.Enabled = True
    mainUserForm.automationfail_yes.Enabled = True
    mainUserForm.knightregression_yes.Enabled = True

    ' Empty resource and time textboxes
    mainUserForm.preflight_resource = vbNullString
    mainUserForm.preflight_time = vbNullString





End Sub
' Record values according to checkboxes checked in form
Public Sub RecordCheckboxChange(mainUserForm As UserForm1, checkBoxControl As MSForms.CheckBox, formType As String, Optional exactTaskTitle As String)

    ' Declare objects
    Dim resultRange As Range

    ' Declare other variables
    Dim parentCaption As String
    Dim checkboxCaption As String
    Dim taskTitle As String
    Dim resourceValue As Double
    Dim timeValue As Double
    Dim resourceColumn As Integer
    Dim timeColumn As Integer

    ' Reset find parameters
    Application.FindFormat.Clear

    ' Define which column to sum based on formType
    Select Case formType

    Case "Mobile"

        resourceColumn = 5
        timeColumn = 7

    Case "Desktop"

        resourceColumn = 6
        timeColumn = 8

    End Select

    ' Store the captions (parent and checkbox)
    parentCaption = checkBoxControl.Parent.Caption
    checkboxCaption = checkBoxControl.Caption

    ' If task title comes from code inside checkbox event, use it
    If exactTaskTitle <> vbNullString Then

        taskTitle = exactTaskTitle

    Else

        taskTitle = parentCaption & "*" & checkboxCaption

    End If

    ' Find the parent and checkbox caption (using wildcards it's more simple)
    Set resultRange = Sheets("Preflight").Range("A2:A32").Find(taskTitle, Lookat:=xlPart)

    ' If checkbox is checked record value
    If checkBoxControl.Value = True Then
        resourceValue = resultRange.Offset(0, resourceColumn).Value
        timeValue = resultRange.Offset(0, timeColumn).Value
    Else
        resourceValue = 0
        timeValue = 0
    End If

    ' Store the value in spreadsheet
    resultRange.Offset(0, resourceColumn + 6).Value = resourceValue
    resultRange.Offset(0, timeColumn + 6).Value = timeValue

    ' Update the textboxes with totals
    mainUserForm.preflight_resource = ThisWorkbook.Worksheets("Preflight").Range("L35").Value
    mainUserForm.preflight_time = ThisWorkbook.Worksheets("Preflight").Range("N35").Value

    ' Reset find parameters
    Application.FindFormat.Clear

End Sub

推荐阅读