Блог

Главная - Вопросы по программированию - Несколько флажков формы пользователя, не записывающих на лист после первого оператора IF

Несколько флажков формы пользователя, не записывающих на лист после первого оператора IF

#excel #vba

Вопрос:

Он все, я продвигаюсь в своем первом крупном проекте VBA, у меня есть несколько флажков для выбора типа обуви, который затем будет использовать значения выпадающих списков для записи каждого размера с данными в новой строке. Я пытаюсь реализовать это с помощью командной кнопки (commandbuttonapply), но могу заставить ее вставить только первую. В окончательном проекте будет около 67 флажков.

 Private Sub CommandButtonApply_Click()
  
  Call Checkboxes



End Sub


Sub Checkboxes()
If Me.CheckBox9k.Value = True And Me.CheckBox95k.Value = True Then
    Else
    If Me.CheckBox9k.Value = True Then
    Call CheckBox9ktrue
    
    ElseIf Me.CheckBox95k.Value = True Then
    Call checkbox95ktrue
          
                    Exit Sub
End If
End If




  End Sub
    
    Sub checkbox95ktrue()

'''Input
        
    Dim ws As Worksheet
    Dim LastRow As Long, RowInsert As Long
    
    Set ws = ThisWorkbook.Worksheets("stock")
     With ws
        LastRow = .Cells(Rows.Count, "A").End(xlUp).row
        
        RowInsert = .Range("A1:A" amp; LastRow).Find("*", .Cells(LastRow, "A"), xlValues, , , xlPrevious).row
        RowInsert = RowInsert   1
        RowInvert = RowInsert - 1
        
        
    
    'add the uk size input code here
    
  '''Checkbox based search
 
 ''Start
  
    
        
        If Me.comboboxbrand.Value = "" Then
    MsgBox "please enter a brand", vbInformation
        Exit Sub
        End If
        
    If Me.comboboxgender.Value = "" Then
    MsgBox "please enter an item gender", vbInformation
        Exit Sub
        End If
        
    If Me.comboboxclosure.Value = "" Then
    MsgBox "please enter a closure type", vbInformation
        Exit Sub
        End If
        
    If Me.comboboxmaterial.Value = "" Then
    MsgBox "please enter an upper material type", vbInformation
        Exit Sub
        End If
        
    'If Me.comboboxuksize.Value = "" Then
    'MsgBox "please enter the uk size", vbInformation
        'Exit Sub
        'End If
        
  
        
     If Me.comboboxmodel.Value = "" Then
    MsgBox "please enter a model type", vbInformation
       
        
        
        ElseIf Me.CheckBox9k.Value = True Then
    
   

                                         ''''This has to match the number of rows input below
        .Cells(RowInsert, "A").Resize(1, 8).Value = Array( _
            Me.txtDate.Text, _
            Me.textboxparentsku.Text, _
            Me.comboboxbrand.Text, _
            Me.comboboxclosure.Text, _
            Me.comboboxgender.Text, _
            Me.comboboxmaterial.Text, _
            Me.comboboxmodel.Text, _
            Me.ComboBoxcolour.Text _
        )
        ws.Range("I" amp; RowInsert).Value = CheckBox95k.Caption
        
        'ElseIf Me.CheckBox9k.Value = False Then .Cells(RowInvert, "A").Resize(1, 9).Value = ""
                                                
    

End If
''Finish

 

    
   
    
    
    Set ws = Nothing


End With

End Sub



Sub CheckBox9ktrue()

'''Input
    
Dim ws As Worksheet
Dim LastRow As Long, RowInsert As Long

Set ws = ThisWorkbook.Worksheets("stock")
 With ws
    LastRow = .Cells(Rows.Count, "A").End(xlUp).row
    
    RowInsert = .Range("A1:A" amp; LastRow).Find("*", .Cells(LastRow, "A"), xlValues, , , xlPrevious).row
    RowInsert = RowInsert   1
    RowInvert = RowInsert - 1
    
    

'add the uk size input code here

  '''Checkbox based search
 
 ''Start



    
    If Me.comboboxbrand.Value = "" Then
MsgBox "please enter a brand", vbInformation
    Exit Sub
    End If
    
If Me.comboboxgender.Value = "" Then
MsgBox "please enter an item gender", vbInformation
    Exit Sub
    End If
    
If Me.comboboxclosure.Value = "" Then
MsgBox "please enter a closure type", vbInformation
    Exit Sub
    End If
    
If Me.comboboxmaterial.Value = "" Then
MsgBox "please enter an upper material type", vbInformation
    Exit Sub
    End If
    
'If Me.comboboxuksize.Value = "" Then
'MsgBox "please enter the uk size", vbInformation
    'Exit Sub
    'End If
    

    
 If Me.comboboxmodel.Value = "" Then
MsgBox "please enter a model type", vbInformation
   
    
    
    ElseIf Me.CheckBox9k.Value = True Then



                                     ''''This has to match the number of rows input below
    .Cells(RowInsert, "A").Resize(1, 8).Value = Array( _
        Me.txtDate.Text, _
        Me.textboxparentsku.Text, _
        Me.comboboxbrand.Text, _
        Me.comboboxclosure.Text, _
        Me.comboboxgender.Text, _
        Me.comboboxmaterial.Text, _
        Me.comboboxmodel.Text, _
        Me.ComboBoxcolour.Text _
    )
    ws.Range("I" amp; RowInsert).Value = CheckBox9k.Caption
    
    'ElseIf Me.CheckBox9k.Value = False Then .Cells(RowInvert, "A").Resize(1, 9).Value = ""
                                            


End If
''Finish







Set ws = Nothing


End With


End Sub

Комментарии:

1. Не связано с вашим запросом, но ваша работа будет намного проще, если вы будете использовать последовательные отступы и не будете включать случайные избыточные пробелы.

2. Спасибо, я демонстративно демонстрирую свои любительские навыки, чтобы получить хорошую практику до того, как сформируются вредные привычки, В VBA это не так разнесено, как сейчас.

3. Вы идете прямо от а Then до Else в. Ты что, пропустил какой-то шаг?

4. Ах, это остатки того, что я пробовал разные вещи, спасибо за место.

5. Просто используйте RowInsert = LastRow 1 , и ElseIf Me.CheckBox9k.Value = True Then в конце Sub checkbox95ktrue() у вас будет распространенная ошибка копирования/вставки.

Ответ №1:

Вам не нужно иметь подменю для каждого флажка, вы можете использовать Me.Controls(variable) 

 Option Explicit

Private Sub CommandButtonApply_Click()
    Call Checkboxes
End Sub

Sub Checkboxes()

    Dim ar, data(8) As String, n As Integer, i As Integer, msg As String
    ar = Array("brand", "closure", "gender", "material", "model", "colour")
    
    ' validate inputs
    data(0) = Me.TxtDate.Text
    data(1) = Me.TextBoxparentsku.Text
    For n = 0 To UBound(ar)
        data(n   2) = Me.Controls("ComboBox" amp; ar(n)).Value
        If data(n   2) = "" Then
            msg = msg amp; vbCrLf amp; ar(n)
        End If
    Next

    ' any blanks
    If msg <> "" Then
        MsgBox "Please enter a value in :" amp; msg, vbExclamation
        Exit Sub
    End If

    ' count number of checkboxes checked
    Dim arChk, s As String
    arChk = Array("9k", "95k")
    For n = 0 To UBound(arChk)
        s = "CheckBox" amp; arChk(n)
        If Me.Controls(s).Value = True Then
            data(8) = Me.Controls(s).Caption ' Col I
            i = i   1
        End If
    Next

    ' only 1 allowed
    If i = 0 Then
        MsgBox "No checkbox", vbExclamation
        Exit Sub
    ElseIf i > 1 Then
        MsgBox "More than 1 checkbox", vbExclamation
        Exit Sub
    End If

    ' update worksheet
    Dim ws As Worksheet, LastRow As Long
    Set ws = ThisWorkbook.Worksheets("stock")
    With ws
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        .Cells(LastRow   1, "A").Resize(1, 9).Value = data
    End With
End Sub

Комментарии:

1. Это вызвало много проблем, спасибо, что я включил это, и это значительно упростило ситуацию.

Метки: ,