Импорт помеченных флажков в таблицу

Question

У меня есть пользовательская форма, из которой я хочу импортировать значения в предопределенную таблицу (называемую «Overzicht»).

У меня 12 флажков (по одному на каждый месяц), и я хочу одну строку для каждого месяца, если этот флажок установлен. Я хочу поставить флажок «Заголовок» в одном из столбцов таблицы.

Например, если я проверяю январь, февраль и март, я хочу импортировать все значения в таблицу в три строки, где В первой строке столбца «Месяц» написано «Январь», во второй «Февраль» и т. д. c.

У меня есть код, который проверяет количество отмеченных флажков и создает такое же количество строк. Я не знаю, как получить правильные заголовки в строках. Это то, что у меня есть:

Private Sub CommandButton1_Click()

Dim rng As Range
Dim newrow As ListRow
Set rng = ThisWorkbook.Worksheets("Kostenoverzicht").Range("Overzicht")
Dim answer As Integer
'check number of rows to insert based on # of checked months
Dim ctl As MSForms.Control
Dim rows As Long
For Each ctl In Kostenoverzicht.Frame2.Controls
If TypeOf ctl Is MSForms.CheckBox Then
If Kostenoverzicht.Frame2.Controls(ctl.Name).Value = True Then
rows = rows + 1
End If
End If
Next

answer = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?")

If answer = vbYes Then
rng.Select
Set newrow = Selection.ListObject.ListRows.Add(alwaysinsert:=True)
With ws
For rows = 1 To rows
newrow.Range.Cells(rows, 1).Value = Me.TextBox1.Value
newrow.Range.Cells(rows, 2).Value = Me.CategorieBox.Value
newrow.Range.Cells(rows, 3).Value = Me.SubCategorieBox.Value
newrow.Range.Cells(rows, 4).Value = Me.BankrekeningBox.Value
If OptionButton1.Value = True Then newrow.Range.Cells(rows, 5).Value = "Af" Else newrow.Range.Cells(1, 5).Value = "Bij"
newrow.Range.Cells(rows, 6).Value = Me.TextBox2.Value
newrow.Range.Cells(rows, 7).Value = Me.CheckBox1.Caption
If OptionButton3.Value = True Then newrow.Range.Cells(rows, 8).Value = "Ja" Else newrow.Range.Cells(1, 8).Value = "Nee"
Next
End With

End If
End Sub

Это даст значение "Январь" для всех строк.

Мне нужен код для замены newrow.Range.Cells(rows, 7).Value = Me.CheckBox1.Caption, чтобы взять заголовок флажок установлен.

Я пытался найти ответ на нескольких сайтах.

Answer 1

Этот код должен go позади вашей пользовательской формы

Вот несколько советов для того, когда вы кодируете:

1. Используйте явную опцию , чтобы вы не делали непредсказуемое поведение с неопределенными переменными
2. Всегда делайте отступ в своем коде (см. www.rubberduckvba.com бесплатный инструмент, который поможет вам в этом)
3. Попробуйте отделить логи c определение переменных и их повторное использование

Просмотрите и настройте код так, чтобы он соответствовал вашим потребностям.

Чтобы увидеть, что происходит в коде, добавьте stop и нажмите F8 и выполнение его построчно.

Код:

Option Explicit

Private Sub CommandButton1_Click()

    ProcessForm

End Sub

Private Sub ProcessForm()

    Dim targetControl As MSForms.control

    Dim continue As Boolean

    continue = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?") = vbYes

    ' If it's not yes
    If Not continue Then Exit Sub

    For Each targetControl In Me.Controls

        If TypeOf targetControl Is MSForms.CheckBox Then
            Select Case targetControl.Value
            Case True
                ' Call the RecordData procedure (remember to add the controls in the parameters)
                RecordData targetControl.Caption, Me.TextBox1.Value, Me.TextBox2.Value
            Case False
                ' Do something?
            End Select
        End If

    Next targetControl
End Sub

Private Sub RecordData(ByVal recordMonth As String, ByVal textbox01Value As String, ByVal textbox02Value As String)

    Dim targetTable As ListObject
    Dim newRow As ListRow

    ' Refer to the table (no need for the worksheet reference)
    Set targetTable = Range("Overzicht").ListObject

    ' Add a new row an set a reference
    Set newRow = targetTable.ListRows.Add

    ' Refer to the columns by their header (replace with yours)
    newRow.Range.Cells(1, targetTable.ListColumns("Month").Index).Value = recordMonth
    newRow.Range.Cells(1, targetTable.ListColumns("Textbox1").Index).Value = textbox01Value
    newRow.Range.Cells(1, targetTable.ListColumns("Textbox2").Index).Value = textbox02Value

End Sub

Дайте мне знать, если это работает, или вам нужна дополнительная помощь

Answer 2

Не обращая внимания на мой первый ответ, я неправильно понял и подумал, что это будет всегда go с января до какого-то другого месяца. Но теперь, кажется, это также может быть просто септ и нов, например. Найдите старый / неправильный ответ внизу. Мне почему-то трудно понять ваш код. Вы проверяете, сколько строк нужно вставить вверху, и тогда все строки, похоже, содержат в себе одинаковую информацию, поскольку ячейки 1-6 являются значениями из других не переменных / динамических c источников? Я не уверен, что понимаю, что происходит. Это также своего рода вызов пользовательской формы, верно? Я не могу действительно восстановить то, что у вас есть, потому что я не совсем знаю.

Лучший выстрел:

Private Sub CommandButton1_Click()

Dim rng As Range
Dim newrow As ListRow
Set rng = ThisWorkbook.Worksheets("Kostenoverzicht").Range("Overzicht")
Dim answer As Integer
Dim ctl As MSForms.Control
Dim rows As Long

answer = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?")
If Not answer = vbYes Then Exit Sub

For Each ctl In Kostenoverzicht.Frame2.Controls
    If TypeOf ctl Is MSForms.CheckBox Then
        If Kostenoverzicht.Frame2.Controls(ctl.Name).Value = True Then
            Set newrow = rng.ListObject.ListRows.Add(alwaysinsert:=True)

            newrow.Range.Cells(rows, 1).Value = Me.TextBox1.Value
            newrow.Range.Cells(rows, 2).Value = Me.CategorieBox.Value
            newrow.Range.Cells(rows, 3).Value = Me.SubCategorieBox.Value
            newrow.Range.Cells(rows, 4).Value = Me.BankrekeningBox.Value

            If OptionButton1.Value = True Then newrow.Range.Cells(rows, 5).Value = "Af" Else newrow.Range.Cells(1, 5).Value = "Bij"

            newrow.Range.Cells(rows, 6).Value = Me.TextBox2.Value
            newrow.Range.Cells(rows, 7).Value = ctl.Name 'Or maybe ctl.Caption ?

            If OptionButton3.Value = True Then newrow.Range.Cells(rows, 8).Value = "Ja" Else newrow.Range.Cells(1, 8).Value = "Nee"


        End If
    End If
Next

End Sub

Я надеюсь, вы понимаете, что я пытаюсь сделать здесь, и можете исправить это к вашим потребностям / ошибка исправить. Как я уже сказал, я не перестраивал лист, чтобы проверить его. Может быть, это поможет вам независимо.

Старый:

newrow.Range.Cells(rows, 7).Value = Format(3 + 31 * (rows - 1), "MMMM")