Excel 动态创建的复选框始终不返回正确的值(真/假)

Excel 动态创建的复选框始终不返回正确的值(真/假),excel,vba,Excel,Vba,我有一个动态创建控件的窗体。控件之一,即当我尝试获取值时,复选框没有给出正确的值;有时和大多数情况下,即使在检查时,它也会给出false。请查找代码片段 Sub temp_gauge_popups() Dim shDatabase As Worksheet Dim lastrow As Long Dim itr As Long Dim mydate1 As Date Dim mydate2 As Long Dim datetoday1 As Da

我有一个动态创建控件的窗体。控件之一,即当我尝试获取值时,复选框没有给出正确的值;有时和大多数情况下,即使在检查时,它也会给出false。请查找代码片段

Sub temp_gauge_popups()

    Dim shDatabase As Worksheet
    Dim lastrow As Long
    Dim itr As Long
    Dim mydate1 As Date
    Dim mydate2 As Long
    Dim datetoday1 As Date
    Dim datetoday2 As Long
    Dim msgstring As String
    Dim record_count As Long
    frmTmpGauges.Show vbModeless
    Dim theLabel1 As Object
    Dim theLabel2 As Object
    Dim theLabel3 As Object
    Dim theLabel4 As Object
    Dim inc As Integer
    Dim flag As Integer
    Dim num As Long

    Set shDatabase = ThisWorkbook.Sheets("Database")
    lastrow = [Counta(Database!A:A)]

    inc = 0
    record_count = 0
    datetoday1 = Date
    datetoday2 = datetoday1
    flag = 0
    num = 1

    For itr = 2 To lastrow

        mydate1 = shDatabase.Cells(itr, 19).Value
        mydate2 = mydate1

        If Trim(shDatabase.Cells(itr, 19).Value) <> "" Then

            If shDatabase.Cells(itr, 17).Value = "Temporary" And (mydate2 + shDatabase.Cells(itr, 18).Value) <= datetoday2 Then

                record_count = record_count + 1
                flag = 1

                Set theLabel1 = frmTmpGauges.Controls.Add("Forms.Textbox.1", "Type_of_Gauge" & record_count, True)
                With theLabel1
                    .Value = shDatabase.Cells(itr, 3).Value
                    .Left = 18
                    .Width = 150
                    .Height = 18
                    .Top = 54 + inc
                    .TextAlign = 1
                    .BackColor = &HC0FFFF
                    .BackStyle = 0
                    .BorderStyle = 1
                    .BorderStyle = 0
                    .Locked = True
                    .ForeColor = &HC00000
                    .Font.Size = 9
                    .TabIndex = itr - 1
                End With

                Set theLabel2 = frmTmpGauges.Controls.Add("Forms.Textbox.1", "Identification" & record_count, True)
                With theLabel2
                    .Value = shDatabase.Cells(itr, 4)
                    .Left = 175
                    .Width = 132
                    .Height = 18
                    .Top = 54 + inc
                    .TextAlign = 1
                    .BackColor = &HC0FFFF
                    .BackStyle = 0
                    .BorderStyle = 1
                    .BorderStyle = 0
                    .Locked = True
                    .ForeColor = &HC00000
                    .Font.Size = 9
                    .TabIndex = itr
                End With

                Set theLabel3 = frmTmpGauges.Controls.Add("Forms.Textbox.1", "Issued_To" & record_count, True)
                With theLabel3
                    .Value = shDatabase.Cells(itr, 16)
                    .Left = 299
                    .Width = 54
                    .Height = 18
                    .Top = 54 + inc
                    .TextAlign = 2
                    .BackColor = &HC0FFFF
                    .BackStyle = 0
                    .BorderStyle = 1
                    .BorderStyle = 0
                    .Locked = True
                    .ForeColor = &HC00000
                    .Font.Size = 9
                    .TabIndex = itr + 1
                End With

                Set theLabel4 = frmTmpGauges.Controls.Add("Forms.Checkbox.1", "chkboxrcvd" & record_count, True)
                With theLabel4
                    .Left = 390
                    .Width = 12.5
                    .Height = 18
                    .Top = 52 + inc
                    .TextAlign = 2
                    .TabIndex = itr - 2

                End With

            End If

    End If

    If flag = 1 Then

        inc = inc + 18
        flag = 0

    End If

    Next

frmTmpGauges.cmdUpdateTG.Top = 66 + (18 * record_count)
frmTmpGauges.Height = 138.75 + (18 * record_count)

frmForm.txtTempRecordCnt.Value = record_count

End Sub
如快照中所示,即使选中复选框,它也会将False显示为值。任何帮助都将不胜感激。
提前感谢。

尝试以下操作并在即时窗口中检查输出。 选项显式

Public Sub Test()
    Dim itr3 As Long
    itr3 = 1

    Do
        Dim OneControl As Object
        On Error Resume Next
            Set OneControl = frmTmpGauges.Controls("chkboxrcvd" & itr3)
            If Err.Number <> 0 Then Exit Do
        On Error GoTo 0

        If OneControl.Value = True Then
            Debug.Print itr3, "Recieved"
        Else
            Debug.Print itr3, "---"
        End If
        itr3 = itr3 + 1

    Loop
    On Error GoTo 0 'needed because of exit do!
End Sub
循环的方式可能会失败,因为对于frmTmpGauges中的每个控件,控件的编号顺序可能不正确,10个控件的编号顺序从1…10开始,但例如2,1,3,5,4…但是循环仅适用于顺序正确的控件1…10


此循环的工作方式将始终在1…10中输出它们。

复选框是如何生成的?你能包括那个代码吗?我能想象的唯一一件事是,您认为第一个复选框是chkboxrcvd1,但它不是列表中的第一个复选框。VBA没有说谎,如果它说值为假,那么它就是。@Pᴇʜ我添加了代码只是一个注释:如果你只是将inc=inc+18放在标签4末尾的正下方,你就不需要那个标志了代码在我看来没有错。这应该行得通。也许消息是上次通过循环时发出的?@Pᴇ当然,谢谢。我注意到的另一件事是,当我在动态控件中循环时,这些控件的计数是它应该计数的两倍。例如,这里我有5个复选框控件,但我得到10个计数。有什么原因吗?
Public Sub Test()
    Dim itr3 As Long
    itr3 = 1

    Do
        Dim OneControl As Object
        On Error Resume Next
            Set OneControl = frmTmpGauges.Controls("chkboxrcvd" & itr3)
            If Err.Number <> 0 Then Exit Do
        On Error GoTo 0

        If OneControl.Value = True Then
            Debug.Print itr3, "Recieved"
        Else
            Debug.Print itr3, "---"
        End If
        itr3 = itr3 + 1

    Loop
    On Error GoTo 0 'needed because of exit do!
End Sub