基于表单选择的密码捕获

Question

这个网站和一般的 VBA 都是新手，所以希望我在这里发帖能帮助我找到答案。提前感谢大家的建议！

这是我的情况和问题：

在我的办公室，创建了一个报告生成器工具来帮助管理人员提取 Excel 工作表数据并生成交叉引用报告。该报告是根据用户选择的参数生成的。

有一个条件，如果用户在一个参数字段中选择“员工姓名”，而他们在另一个字段中选择“Total Direct Labor Dollars”、“Sell”或“Total Labor Prime”，他们将被要求输入密码以继续。我目前拥有的代码是要求用户输入密码......但只要选择了“员工姓名”，它就会要求输入密码，而不管在另一个中选择了任何字段。

    Sub FormattingNums(critNum As Long, repSelNum As Long, Month As String, Year As String, _
    MonthNum As Long, YearNum As Long, reportNum As Long, dateDiff As Long, dateDiffYear As Long, _
    dateDiffMonth As Long, byWeek As Boolean, autoFormat As Boolean, monthSummary As Boolean, weekSummary As Boolean, _
    Mode2013 As Boolean, chartmaker As Boolean, title As String)

    Dim lCount      As Long     'Counter for going through list
    Dim formCheck   As Boolean  'For LevelDepth Selection
    Dim rCount      As Long     'Counter for going through report list
    Dim pw          As Boolean
    On Error GoTo errHandler

    byWeek = frmNewProjectReport.chbByWeek.Value 'Boolean user selection
    autoFormat = frmNewProjectReport.chbAutoFormat.Value 'Boolean user selection
    monthSummary = frmNewProjectReport.chbSumMonth.Value 'Boolean user selection
    chartmaker = frmNewProjectReport.chbChart.Value 'Boolean user selection
    title = frmNewProjectReport.txtProjectName      'String of Report title

    dateDiffYear = frmNewProjectReport.cmbEndYear.Value - frmNewProjectReport.cmbBeginYear.Value 'Integer
    dateDiffMonth = frmNewProjectReport.cmbEndMonth.Value - frmNewProjectReport.cmbBeginMonth.Value 'Integer
    dateDiff = (dateDiffYear * 12) + dateDiffMonth 'Integer
    MonthNum = frmNewProjectReport.cmbBeginMonth.Value 'Number
    YearNum = frmNewProjectReport.cmbBeginYear.Value 'Number
    Month = MonthNum 'String
    Year = YearNum 'String
    If (MonthNum < 2 And YearNum = 2014) Or (YearNum < 2014) Then
        Mode2013 = True
    End If

    reportNum = frmNewProjectReport.txtReportQuant 'Number of reports chosen
    critNum = 0
    repSelNum = 0
    With frmNewProjectReport.lbxCriteria    'Counts number of criteria choices selected
        For lCount = 0 To .ListCount - 1
            If .Selected(lCount) = True Then
                'For selection of levels
                If .List(lCount) = "Level" Then
                    frmLevelDepthSelection.Show
                    If frmLevelDepthSelection.cmbLevelSelection.Value = "Levels" Then
                        formCheck = False
                        Do While formCheck = False
                            MsgBox "You must select a Level to Continue", vbExclamation, "Report Creation Assistant"
                            frmLevelDepthSelection.Show
                            If frmLevelDepthSelection.cmbLevelSelection.Value <> "Levels" Then
                                formCheck = True
                            End If
                        Loop
                    End If
                ElseIf .List(lCount) = "Employee Name" Then
                    With frmNewProjectReport.lbxReport
                        For rCount = 0 To .ListCount - 1
                            If .List(rCount) = "Cost" _
                            Or .List(rCount) = "Total Direct Labor Dollars" _
                            Or .List(rCount) = "Sell" _
                            Or .List(rCount) = "Total Labor Prime" Then
                                Do While pw = False
                                    frmHourlyRate.Show
                                    If frmHourlyRate.txtHourlyRate.Value = "BMAccess" Then
                                        pw = True
                                    Else
                                        MsgBox "Incorrect password", vbOKOnly, "Incorrect Password"
                                    End If
                                Loop
                            End If
                        Next rCount
                    End With
                End If
                critNum = critNum + 1
            End If
        Next
    End With
    With frmNewProjectReport.lbxReport 'Counts number of report choices selected
        For lCount = 0 To .ListCount - 1
            If .Selected(lCount) = True Then
                repSelNum = repSelNum + 1
            End If
        Next
    End With
Exit Sub
End Sub

我做错了什么？

再次感谢大家！

*edit：我添加了整个 Sub 以便你们看到。不确定它是否会有所帮助，但不会造成伤害:)。再次感谢！

Answer 1

您正在迭代整个列表框并根据您的值测试每个字符串，因此只要这些字符串作为列表项存在，您总是会匹配。

您需要对照您的字符串检查 selected 值。

变化：

For rCount = 0 To .ListCount - 1
    If .List(rCount) = "Cost" _
    Or .List(rCount) = "Total Direct Labor Dollars" _
    Or .List(rCount) = "Sell" _
    Or .List(rCount) = "Total Labor Prime" Then

收件人：

If .Text = "Cost" _
Or .Text = "Total Direct Labor Dollars" _
Or .Text = "Sell" _
Or .Text = "Total Labor Prime" Then

看来您的"Employee Name" 列表框也可能做错了。