如何在VBA用户表单中用status选项按钮组验证未选中状态？

现有代码 #

Private Sub Übernehmenbutton_Click()

Dim ctrl As Control
Dim emptyField As Boolean

    
emptyField = False


For Each ctrl In Me.Controls
    If TypeOf ctrl Is ComboBox Or ctrl.Name = "AufgabeText" Then
                If Trim(ctrl.Value) = "" Then
                emptyField = True
                ctrl.SetFocus
                ctrl.BackColor = vbYellow
                MsgBox "Please fill in the required field.", vbExclamation, "Missing Value"
                Exit For
            Else
                ctrl.BackColor = vbWhite
            End If
        End If
    Next ctrl
    
If emptyField = False Then
'if there are no emptyfield
    
Dim last As Integer
       
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'Business A & B gewählt
ActiveSheet.Cells(last, 3).Value = Business.Value

        
'Die Dateien von Status übernehmen
If Offen = True Then
    ActiveSheet.Cells(last, 5).Value = Offen.Caption
ElseIf Erledigt = True Then
    ActiveSheet.Cells(last, 5).Value = Erledigt.Caption
ElseIf Warte = True Then
    ActiveSheet.Cells(last, 5).Value = Warte.Caption
ElseIf Begonnen = True Then
    ActiveSheet.Cells(last, 5).Value = Begonnen.Caption
End If


'Aufgabe Text in zellen übernehmen

ActiveSheet.Cells(last, 2).Value = AufgabeText
     
'Echtzeit übernehmen
 ActiveSheet.Cells(last, 1) = Now
 
 'Fälligskeit datum
 ActiveSheet.Cells(last, 4) = Tag1.Value & "" & Monat1.Value & "" & Jahr1.Value
 
 
With Range("A2:E" & last).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End With


With Range("A2:E" & last).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With

With Range("A2:E" & last).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With
    
With Range("A2:E" & last).Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With

With Range("A2:E" & last).Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With
Unload UserForm1
    End If

 
End Sub

现有功能说明 #

初始化变量后遍历用户表单控件，验证ComboBox及名为AufgabeText的控件是否为空；若无不空字段，则将表单数据写入Excel新行，设置单元格边框后卸载用户表单。

需求 #

需实现名为"status"的选项按钮组的验证功能，检查该组是否有选项未被选中，目前未找到控制该按钮组的方法，求实现指导。

解决方案 #

核心思路 #

VBA用户表单中选项按钮组通过GroupName属性分组，只需遍历所有OptionButton控件，判断其GroupName是否为"status"，再检查是否有选中项即可。

修改后的完整代码 #

Private Sub Übernehmenbutton_Click()

Dim ctrl As Control
Dim emptyField As Boolean
Dim statusSelected As Boolean ' 新增状态验证变量

emptyField = False
statusSelected = False ' 初始化状态为未选中

' 验证ComboBox和AufgabeText
For Each ctrl In Me.Controls
    If TypeOf ctrl Is ComboBox Or ctrl.Name = "AufgabeText" Then
        If Trim(ctrl.Value) = "" Then
            emptyField = True
            ctrl.SetFocus
            ctrl.BackColor = vbYellow
            MsgBox "Please fill in the required field.", vbExclamation, "Missing Value"
            Exit For
        Else
            ctrl.BackColor = vbWhite
        End If
    End If
Next ctrl

' 验证status选项按钮组
If Not emptyField Then
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is OptionButton Then
            If ctrl.GroupName = "status" Then ' 匹配目标选项组
                If ctrl.Value = True Then
                    statusSelected = True
                    Exit For ' 找到选中项立即终止遍历
                End If
            End If
        End If
    Next ctrl
    
    If Not statusSelected Then
        MsgBox "Please select a status option.", vbExclamation, "Missing Status"
        Me.Controls("Offen").SetFocus ' 将焦点定位到第一个状态选项，提升体验
        Exit Sub ' 终止后续流程
    End If
End If

' 所有验证通过后执行数据写入逻辑
If Not emptyField And statusSelected Then
    Dim last As Integer
       
    last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

    'Business A & B gewählt
    ActiveSheet.Cells(last, 3).Value = Business.Value

    'Die Dateien von Status übernehmen
    If Offen = True Then
        ActiveSheet.Cells(last, 5).Value = Offen.Caption
    ElseIf Erledigt = True Then
        ActiveSheet.Cells(last, 5).Value = Erledigt.Caption
    ElseIf Warte = True Then
        ActiveSheet.Cells(last, 5).Value = Warte.Caption
    ElseIf Begonnen = True Then
        ActiveSheet.Cells(last, 5).Value = Begonnen.Caption
    End If

    'Aufgabe Text in zellen übernehmen
    ActiveSheet.Cells(last, 2).Value = AufgabeText
     
    'Echtzeit übernehmen
    ActiveSheet.Cells(last, 1) = Now
 
    'Fälligskeit datum
    ActiveSheet.Cells(last, 4) = Tag1.Value & "" & Monat1.Value & "" & Jahr1.Value
 
    '设置单元格边框
    With Range("A2:E" & last).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    With Range("A2:E" & last).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

    With Range("A2:E" & last).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    
    With Range("A2:E" & last).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

    With Range("A2:E" & last).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    
    Unload UserForm1
End If

End Sub

关键注意事项 #

• 确保Offen、Erledigt、Warte、Begonnen这几个选项按钮的GroupName属性均设置为"status"，否则验证逻辑无法生效。
• 验证流程按顺序执行：先检查必填输入框，再检查状态选项，符合用户操作逻辑。
• 未选中状态时，自动将焦点定位到第一个状态选项，减少用户操作步骤。

内容的提问来源于stack exchange，提问作者Blghn