Автоматическое создание элемента флажка - PullRequest
1 голос
/ 07 апреля 2020

Screenshot1

Привет всем,

Я застрял в этом в течение некоторого времени ... Я надеюсь, что кто-то может просветить меня об этом. Итак, я создал здесь 4 списка (ActiveX), и я надеюсь создать флажки внутри каждого списка, чтобы каждый раз, когда я мог скрыть / показать лист Excel из одной и той же книги, просто выбрав ее. Однако у меня слишком много вкладок в одной только книге. Кроме того, все эти вкладки похожи на Warehouse 1, Warehouse 2, Security 1, Security 2, et c et c. Так что перед этими числами есть что-то вроде общего имени.

Мне было интересно, есть ли вообще возможность автоматически генерировать флажки в соответствии с именами вкладок?

Например, если я выберу 1 под списком Склад он должен ссылаться на вкладку Warehouse 1 в рабочей книге.

Любая помощь будет полезна. Спасибо!

Ответы [ 2 ]

1 голос
/ 07 апреля 2020

Для достижения вашей цели вам сначала необходимо внести некоторые изменения в свойства listbox на листе.

Войдите в режим проектирования и щелкните правой кнопкой мыши listbox> Свойства.

Измените следующие свойства:

  • 'ListStyle' на 1 - fmListStyleOption
  • 'MultiSelect ' до 1 - fmMultiSelectMulti

Изменение ListStyle поместит кнопки выбора слева от каждой записи списка, а настройка MultiSelect изменит кнопки выбора на флажки.

Вот пример кода для заполнения ListBox именами рабочих листов - я предположил, что ваша рабочая таблица, содержащая ListBox, называется "Main" AND Я назвал "Generate CheckBox" кнопка cmdGenerateCheckBox.

Private Sub cmdGenerateCheckBox_Click()

Dim WorksheetArray() As Variant
Dim WorksheetIndex As Long
Dim ArrayElement As Variant
Dim NumberOfSheets As Long
Dim MainSheet As Object

Set MainSheet = ThisWorkbook.Sheets("Main")

NumberOfSheets = ThisWorkbook.Sheets.Count
ReDim WorksheetArray(1 To NumberOfSheets)

For WorksheetIndex = 1 To UBound(WorksheetArray)
    WorksheetArray(WorksheetIndex) = ThisWorkbook.Sheets(WorksheetIndex).Name
Next WorksheetIndex

MainSheet.lstWarehouse.Clear
MainSheet.lstSecurity.Clear

For Each ArrayElement In WorksheetArray()
    If ArrayElement Like "Warehouse*" Then
        MainSheet.lstWarehouse.AddItem ArrayElement
    ElseIf ArrayElement Like "Security*" Then
        MainSheet.lstSecurity.AddItem ArrayElement
    End If
Next ArrayElement

Dim ListItemCounter As Long
Dim ListItem As Variant

'----------------lstWarehouse ListBox-----------------
ListItemCounter = 0
For Each ListItem In MainSheet.lstWarehouse.List
    For Each ArrayElement In WorksheetArray()
        If ListItem = ArrayElement Then
            If ThisWorkbook.Sheets(ArrayElement).Visible = True Then
                MainSheet.lstWarehouse.Selected(ListItemCounter) = True
            ElseIf ThisWorkbook.Sheets(ArrayElement).Visible = False Then
                MainSheet.lstWarehouse.Selected(ListItemCounter) = False
            End If
        Else
            'Do nothing
        End If
    Next ArrayElement
    ListItemCounter = ListItemCounter + 1
Next ListItem

'----------------lstSecurity ListBox-----------------
ListItemCounter = 0
For Each ListItem In MainSheet.lstSecurity.List
    For Each ArrayElement In WorksheetArray()
        If ListItem = ArrayElement Then
            If ThisWorkbook.Sheets(ArrayElement).Visible = True Then
                MainSheet.lstSecurity.Selected(ListItemCounter) = True
            ElseIf ThisWorkbook.Sheets(ArrayElement).Visible = False Then
                MainSheet.lstSecurity.Selected(ListItemCounter) = False
            End If
        Else
            'Do nothing
        End If
    Next ArrayElement
    ListItemCounter = ListItemCounter + 1
Next ListItem

End Sub
0 голосов
/ 07 апреля 2020

enter image description here

Во-первых, я хотел бы поблагодарить Самуила за его драгоценное время, потраченное на то, чтобы помочь мне решить эту проблему. Без его терпения это было бы невозможно!

Во-вторых, чтобы добавить ответ Самуила, вы ДОЛЖНЫ изменить имя списков. Так, например, 1stWarehouse , 1stSecurity . Изменение имени означает go для свойств и изменения (как показано на скриншоте).

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