Highlight Listbox Function

问题

Im looking for assistance in my code in regards to my listbox highlighting and actively changing the highlighted choice based off active sheet.

my listbox auto populates based off the sheets within the workbook and can change active worksheet based off selection but does not auto highlight the initial loaded active sheet as the selection and when manually selected on the workbook does not reflect the changes.

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

回答1:

The ListBox won't show any highlight because no selection has been made. When no selection was made the ListBox has no Value (Text). If you assign a Value programmatically it will be highlighted automatically. If you assign a value not in the list an error will occur.

Consider using the Worksheet_Activate event to set a value.

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

The On Error statement has the function of preventing a crash if the ActiveSheet isn't in the list for whatever reason.

The above idea has been implemented in the solution presented below. You will need to adapt parts of it to use the variable names you are already familiar with.

You should have a userform. I have named mine MyForm. Replace the name in my code with one you like better wherever it appears.
My MyForm has a ListBox called ListBox1. Replace the name in my code with one you like better wherever it appears.

Install the following 3 procedures in a standard code module.

Sub ShowMyForm() ' Variatus @STO 21 Feb 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

End Sub

Sub RefreshMyForm() ' Variatus @STO 21 Feb 2020

Dim i As Integer

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

End Sub

Private Function FormIndex() As Integer ' Variatus @STO 21 Feb 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

End Function

This procedure goes into the ThisWorkbook code module.

Private Sub Workbook_Open() ' Variatus @STO 21 Feb 2020 ShowMyForm End Sub

The procedure below goes into the userform's code module. You can adjust the way the list box is filled to exclude some sheets but it's important that you set the V variable to indicate the currently active sheet.

Private Sub UserForm_Initialize() ' Variatus @STO 21 Feb 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

Finally, this is the procedure you need to install in the code sheet of every worksheet listed in the listbox.

Private Sub Worksheet_Activate() ' Variatus @STO 21 Feb 2020
```
RefreshMyForm
```
End Sub

Now, to put it all together: When the workbook is opened the procedure ShowMyForm is called. If the form gets deleted accidentally thereafter you can reinstate it by calling the same procedure or the Workbook_Open event procedure (which can also be called with F5). If ShowMyForm is called repeatedly it will refuse to open more than one instance of the form.

When the form is shown its Initialize event procedure runs. This procedure lists the sheets in the listbox and sets the current ActiveSheet.

When you change sheets a new sheet gets activated and the Worksheet_Activate event occurs. The relative event procedure calls the ListBox's Initialize event, resetting the list.

When you select another sheet from the listbox it gets activate by this procedure in the UserForm's code sheet. However, I think you have this already.

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

来源：https://stackoverflow.com/questions/60311132/highlight-listbox-function

标签

excel

vba

listbox