Подсветка списка функций

Question

Мне нужна помощь в моем коде в отношении выделения моего списка и активного изменения выделенного выбора на основе активного листа.

мой список автоматически заполняется на основе листов в рабочей книге и может изменять активные рабочие таблицы на основе Выключен выбор, но автоматически не выделяет изначально загруженный активный лист в качестве выбора, и при выборе вручную в рабочей книге изменения не отражаются.

Public ActiveSheetChoice As String

    Private Sub ActiveSheetDisplay_AfterUpdate()

        ActiveSheetChoice = ActiveSheetDisplay.Text

    ' Change sheet based on choice
        Worksheets(ActiveSheetChoice).Activate

    End Sub
Private Sub ActiveSheetDisplayRefresh_Click()

' Declaration
    Dim N As Long

' Clear exsisting entries
    ActiveSheetDisplay.Clear

' Function
    For N = 1 To ActiveWorkbook.Sheets.Count
        ActiveSheetDisplay.AddItem ActiveWorkbook.Sheets(N).Name
    Next N

End Sub

Private Sub UserForm_Initialize()

    ' Declaration
        Dim N As Long


    ' Initalization of active sheet display
        For N = 1 To ActiveWorkbook.Sheets.Count
            ActiveSheetDisplay.AddItem ActiveWorkbook.Sheets(N).Name
        Next N

End Sub

Private Sub ImportButton_Click()

' Declare Variables
    Dim TargetBook As Workbook
    Dim SourceBook As Workbook

' Set Active Workbook
    Set SourceBook = ThisWorkbook

' Display a Dialog Box that allows to select a single file.
    'The path for the file picked will be stored in fullpath variable
        With Application.FileDialog(msoFileDialogFilePicker)

        ' Makes sure the user can select only one file
            .AllowMultiSelect = False

        ' Filter to just the following types of files to narrow down selection options
            .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1

        ' Show the dialog box
            .Show

        ' Opening selected file
            For Each Book In .SelectedItems
                Set TargetBook = Workbooks.Open(Book)
                CopyAllSheets SourceBook, TargetBook
                TargetBook.Close SaveChanges:=False
            Next Book

        ' Refresh Active Sheets
            Call ActiveSheetDisplayRefresh_Click

        ' Inform User of completion
            MsgBox "Data import complete"

        End With

End Sub

' Copy Sheet Function
    Sub CopyAllSheets(Source As Workbook, Target As Workbook)

    ' Determine Number of sheets to copy
        totalSheets = Target.Sheets.Count

    ' Copy
        For Each sh In Target.Sheets
          sh.Copy after:=Source.Sheets(Source.Sheets.Count)
        Next sh

    End Sub

    Private Sub SaveOptionButton_Click()

        ' Save workbook Function
            ThisWorkbook.Save
            MsgBox "Workbook saved!"

    End Sub


' Using Query Close event of Userform
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

' Display information message dialog box
        If CloseMode = vbFormControlMenu Then

            'Changing Cancel variable value to True
                Cancel = True
                MsgBox "Main Options cannot be closed"

        End If

    End Sub

Answer 1

ListBox не будет отображать подсветку, так как выбор не был сделан. Когда выбор не был сделан, ListBox не имеет Value (Text). Если вы назначите Value программно, он будет подсвечен автоматически. Если вы назначите значение, отсутствующее в списке, произойдет ошибка.

Попробуйте использовать событие Worksheet_Activate для установки значения.

Private Sub Worksheet_Activate()
    On Error Resume Next
    ActiveSheetDisplay.Text = ActiveSheet.Name
End Sub

Оператор On Error имеет функция предотвращения взлома sh, если ActiveSheet по какой-либо причине нет в списке.

Вышеуказанная идея была реализована в решении, представленном ниже. Вам нужно будет адаптировать его части для использования имен переменных, с которыми вы уже знакомы.

1. У вас должна быть форма пользователя. Я назвал мой MyForm . Замените имя в моем коде тем, которое вам больше нравится, где бы оно ни появлялось.
2. My MyForm имеет ListBox с именем ListBox1. Замените имя в моем коде тем, которое вам больше нравится, где бы оно ни появилось.

3. Установите следующие 3 процедуры в стандартном модуле кода.

   Sub ShowMyForm () 'Variatus @STO 21 Фев 2020

   Dim UForm As MyForm
   
   If FormIndex = True Then             ' prevents creation of several instances
       Debug.Print "New form"
       Set UForm = New MyForm
       UForm.Show vbModeless
   End If
   

   Конец Sub

   Sub RefreshMyForm () 'Variatus @STO 21 февраля 2020

   Dim i As Integer
   
   i = FormIndex
   If i > -1 Then
       UserForms(i).ListBox1.Text = ActiveSheet.Name
   End If
   

   Конец Sub

   Частная функция FormIndex () As Integer 'Variatus @STO 21 февраля 2020 г.

   Dim i As Integer
   
   For i = UserForms.Count To 1 Step -1
       If UserForms(i - 1).Name = "MyForm" Then Exit For
   Next i
   
   FormIndex = i - 1
   

   Функция завершения

4. Эта процедура входит в модуль кода ThisWorkbook.

   Private Sub Workbook_Open () 'Variatus @STO 21 февраля 2020 ShowMyForm End Sub

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

   Private Sub UserForm_Initialize () 'Variatus @STO 21 февраля 2020 г.

   Dim Ws As Worksheet
   Dim Arr() As String
   Dim V As Integer
   Dim i As Integer
   
   With Worksheets
       ReDim Arr(1 To .Count)
       For i = 1 To .Count
           Arr(i) = .Item(i).Name
           If .Item(i) Is ActiveSheet Then V = i
       Next i
   End With
   
   With ListBox1
       .List = Arr
       .ListIndex = V - 1
   End With
   

   End Sub

6. Наконец, эту процедуру необходимо установить в листе кодов каждого листа, указанного в списке.

   Private Sub Worksheet_Activate () 'Variatus @STO 21 февраля 2020 г.

   RefreshMyForm
   

   End Sub

Теперь, чтобы собрать все воедино: Когда рабочая книга открыта, процедура ShowMyForm вызывается. Если после этого форма была случайно удалена, вы можете восстановить ее, вызвав ту же процедуру или процедуру события Workbook_Open (которую также можно вызвать с помощью F5). Если ShowMyForm вызывается повторно, он откажется открывать более одного экземпляра формы.

Когда форма показывается, запускается процедура события Initialize. Эта процедура перечисляет листы в списке и устанавливает текущий ActiveSheet.

При смене листов активируется новый лист и происходит событие Worksheet_Activate. Процедура относительного события вызывает событие Initialize ListBox, сбрасывая список.

Когда вы выбираете другой лист из списка, он активируется этой процедурой в кодовой таблице UserForm. Тем не менее, я думаю, что у вас уже есть.

Private Sub ListBox1_Click()
    ' Variatus @STO 21 Feb 2020
    Worksheets(ListBox1.Value).Activate
End Sub