Флажок, созданный динамически, всегда не возвращает правильные значения (True / False) - PullRequest
0 голосов
/ 31 марта 2020

У меня есть форма с контролем, созданная динамически. Один из элементов управления, т.е. флажок не дает правильное значение, когда я пытаюсь получить значение; иногда и в большинстве случаев это дает ложь, даже когда «проверено». Найдите фрагмент

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
Private Sub cmdUpdateTG_Click()

    Application.ScreenUpdating = False
    Dim oneControl As Object
    Dim itr3 As Integer

    itr3 = 1

For Each oneControl In frmTmpGauges.Controls
If TypeName(oneControl) = "CheckBox" Then

            If oneControl.Name = "chkboxrcvd" & itr3 Then
                MsgBox "chkboxrcvd" & itr3
                MsgBox oneControl.Value
                If oneControl.Value = True Then
                    shSearch.Cells(itr3, 4) = "Received"
                    itr3 = itr3 + 1
                Else
                    shSearch.Cells(itr3, 4) = ""
                    itr3 = itr3 + 1

                End If
            End If
        End If

enter image description here

Как видно на снимке, даже когда флажок установлен, он показывает "False" в качестве значения , Любая помощь будет высоко ценится. Заранее спасибо.

1 Ответ

1 голос
/ 31 марта 2020

Попробуйте следующее и проверьте вывод в ближайшем окне. Параметр Явный

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

Способ, которым вы l oop может потерпеть неудачу, потому что For Each oneControl In frmTmpGauges.Controls может иметь элементы управления не в правильном порядке, пронумерованном от 1…10 (для 10 элементов управления), но, например, как 2, 1, 3, 5, 4, …, но ваш l oop работает только для них, потому что он работает в правильном порядке 1…10

То, как работает этот l oop, будет всегда выводить их в 1…10.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...