Question

Я пишу пользовательскую форму

Чего я пытаюсь достичь: при запуске моей пользовательской формы с несколькими флажками выбора.

Соберите все подписи отмеченных флажков вместе с родительским фреймомname
Фильтрация базы данных по ее первому столбцу по собранным строкам
Цикл отфильтрованных ячеек и получение необходимых сумм
Выбор может содержать каждую строку с разными столбцами (на основевыбор флажка)

Код для Оценка командная кнопка:

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

Ожидаемый результат: Например:

Если установить флажок следующим образом: США -> Мобильный -> P0 и США -> Рабочий стол -> P1

Выходные данные должны быть:

Текстовые поля ниже:

Используемые ресурсы: (F2 + G3) -> (0,73 + 0,62) -> 1,35 (внутри текстового поля)

Время вЧасы: (H2 + I3) -> (5,87 + 4,95) -> 10,82 (внутри текстового поля)

Как этого добиться?

Ricardo Diaz · Answer 1 · 03 марта 2019

У меня другой подход к решению проблемы вашего вопроса.

Если имеется отдельный столбец для хранения значений каждого выбора, то проверьте его.

Резюме того, чтопроисходит в электронной таблице:

Данные чекбоксов будут храниться под кодом 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

Как добавить дополнительные флажки на основе выбора в Excel VBA

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как добавить дополнительные флажки на основе выбора в Excel VBA

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы