Флажки VBA Excel ListView не отображаются в пользовательской форме

Question

У меня есть UserForm с MultipageControl (имя Controller_MultiPage). Во время выполнения мой код добавляет страницы в Multipage и создает newListView на каждой странице. Каждый ListView имеет:

      With newListView
        .MultiSelect = False
        .Width = Controller_MultiPage.Width - 10
        .Height = Controller_MultiPage.Height - 20
        .View = lvwReport
        .HideColumnHeaders = False
        .ColumnHeaders.Add Text:="Signal Name", Width:=.Width / 10 * 4
        .ColumnHeaders.Add Text:="Type", Width:=.Width / 10
        .ColumnHeaders.Add Text:="I/O", Width:=.Width / 10
        .ColumnHeaders.Add Text:="Description", Width:=.Width / 10 * 4
        .CheckBoxes = True
        .FullRowSelect = True
    End With

, затем я заполняю newListView данными из файла XML:

         For Each node In list
            With node.Attributes
                Set listItem = newListView.ListItems.Add(Text:=.getNamedItem("Name").Text)
                listItem.ListSubItems.Add = .getNamedItem("Type").Text
                listItem.ListSubItems.Add = IIf(.getNamedItem("Input").Text = "1", "IN", "OUT")
                listItem.ListSubItems.Add = .getNamedItem("Description").Text
                listItem.Checked = False
            End With
        Next

, но флажки не отображаются. Я вижу пространство для них перед первым столбцом, и, щелкнув это пространство, появляется флажок этой конкретной строки. Я также заметил, что если я изменю свойство

listItem.Checked = True

, описанное выше поведение не изменится, и когда я щелкну свободное пространство перед первым столбцом (пространство флажков), появится окно chsckbox, которое затем покажет вверх еще не отмечен. Есть идеи?

Answer 1

Проблема, похоже, в поведении элемента управления MultiPage. Я заметил, что если я принудительно установил статус флажков (установлен или не установлен) из кода, используя событие MultiPage_Change, тогда появятся флажки.

Итак, я создал класс, который содержит статус всех флажков всех представлений списков на одной странице, создает экземпляр класса для каждого ListView и сохраняет все в словаре, используя newListView.Name как ключ

Затем, когда пользователь меняет страницу, Событие MultiPage_Change, которое запускается, сбрасывает все значения флажков в соответствии со значениями, сохраненными в Словаре.

В событии Listview_N_ItemChecked какой-то другой код обновляет статус элемента, хранящегося в Словаре. Вроде громоздко, но работает.

класс ( обновлено ):

' Class Name = ComponentsSignalsRecord
Option Explicit

Dim Name As String
' NOTE: Signals(0) will always be empty and status(0) will always be False
Dim Signals() As String
Dim Status() As Boolean
Dim Component As String

Property Let SetComponentName(argName As String)
    Component = argName
End Property

Property Get GetComponentName() As String
    GetComponentName = Component
End Property

Property Get getSignalName(argIndex) As String
    If argIndex >= LBound(Signals) And argIndex <= UBound(Signals) Then
        getSignalName = Signals(argIndex)
    Else
        getSignalName = vbNullString
    End If
End Property

Property Get dumpAll() As String()
    dumpAll = Signals
End Property

Property Get Count() As Long
    Count = UBound(Signals)
End Property

Property Get getStatus(argName As String) As Integer
    ' returns: -1 = Not Found; 1 = True; 0 = False
    getStatus = -1
    Dim i As Integer
    For i = 0 To UBound(Signals)
        If argName = Signals(i) Then getStatus = IIf(Status(i) = True, 1, 0): Exit For
    Next
End Property

Property Let setName(argName As String)
    Name = argName
End Property

Property Get getName() As String
    getName = Name
End Property

Public Sub UncheckAll()
    Dim i As Integer
    For i = 0 To UBound(Status)
        Status(i) = False
    Next
End Sub

Public Sub CheckAll()
    Dim i As Integer
    For i = 0 To UBound(Status)
        Status(i) = True
    Next
End Sub

Public Sub deleteSignal(argName As String)
    Dim spoolSignals() As String
    Dim spoolStatus() As Boolean
    Dim i As Integer
    spoolSignals = Signals
    spoolStatus = Status
    ReDim Signals(0)
    ReDim Status(0)
    For i = 1 To UBound(spoolSignals)
        If argName <> spoolSignals(i) Then
            ReDim Preserve Signals(UBound(Signals) + 1):    Signals(UBound(Signals)) = spoolSignals(i)
            ReDim Preserve Status(UBound(Status) + 1):      Status(UBound(Status)) = spoolStatus(i)
        End If
    Next
End Sub

Public Sub addSignal(argName As String, argValue As Boolean)
    Dim i As Integer
    For i = 0 To UBound(Signals)
        If argName = Signals(i) Then GoTo bye
    Next
    ReDim Preserve Signals(UBound(Signals) + 1)
    ReDim Preserve Status(UBound(Status) + 1)
    Signals(UBound(Signals)) = argName
    Status(UBound(Status)) = argValue
bye:
End Sub

Public Sub setStatus(argName As String, argValue As Boolean)
    Dim i As Integer
    For i = 0 To UBound(Signals)
        If argName = Signals(i) Then Status(i) = argValue: Exit For
    Next
End Sub

Private Sub Class_Initialize()
    ReDim Signals(0)
    ReDim Status(0)
End Sub

Код, соответствующий форме. Уровень модуля:

Dim myDict As New Dictionary                           ' the Dictionary
Dim ComponentsSignalsList As ComponentsSignalsRecord   ' the Class

для каждого созданного ListView, может быть один или несколько для каждой отдельной страницы MultiPage:

Set ComponentsSignalsList = New ComponentsSignalsRecord
ComponentsSignalsList.setName = newListView.name

при заполнении списка (ов) в al oop для каждый отдельный элемент добавлен:

ComponentsSignalsList.addSignal List_Item.Text, List_Item.Checked

конец каждого l oop, добавить экземпляр класса в словарь:

myDict.Add ComponentsSignalsList.getName, ComponentsSignalsList

Теперь при изменении страницы в виджете MultiPage:

Private Sub Controller_MultiPage_Change()
    If isLoading Then Exit Sub   'avoid errors and undue behavior while initializing the MultiPage widget
    Dim locControl As Control
    Dim controlType As String: controlType = "ListView"
    With Controller_MultiPage
        For Each locControl In .Pages(.value).Controls
            If InStr(1, TypeName(locControl), controlType) > 0 Then
                Call Check_CheckBoxes(locControl)
            End If
        Next
    End With
End Sub

Private Sub Check_CheckBoxes(argListView As listView)
    If argListView.CheckBoxes = False Then Exit Sub   'some ListViews don't have checkboxes
    Dim myItem As ListItem
    For Each myItem In argListView.ListItems
        With myItem
            .Checked = myDict.Item(argListView.name).getStatus(.Text)
        End With
    Next
End Sub

при установке / снятии флажка (обратите внимание, что обработчик событий ItemChecked определен в другом классе Public WithEvents, где обработчик вызывает этот метод, передавая как ListView ID, так и объект Item):

Public Sub ListViewsEvents_ItemCheck(argListView As listView, argItem As MSComctlLib.ListItem)
    With argItem
        myDict.Item((argListView .name).setStatus argName:=.Text, argValue:=.Checked
    End With
End Sub