突出显示列表框功能

Question

我在我的代码中寻求有关我的列表框突出显示和主动更改突出显示选项的帮助 sheet。

我的列表框根据工作簿中的 sheet 自动填充，并且可以根据选择更改活动工作sheet，但不会自动突出显示初始加载的活动 sheet 作为选择和在工作簿上手动选择时不反映更改。

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 不会显示任何突出显示，因为还没有创建 selection。当没有创建 selection 时，ListBox 没有 Value (Text)。如果您以编程方式分配 Value ，它将自动突出显示。如果您分配的值不在列表中，则会发生错误。

考虑使用 Worksheet_Activate 事件设置一个值。

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

如果 ActiveSheet 由于任何原因不在列表中，On Error 语句具有防止崩溃的功能。

上面的想法已经在下面给出的解决方案中实现了。您将需要修改其中的部分内容以使用您已经熟悉的变量名。

您应该有一个用户表单。我将我的命名为 MyForm。将我代码中出现的名称替换为您更喜欢的名称。
我的 MyForm 有一个名为 ListBox1 的列表框。将我代码中出现的名称替换为您更喜欢的名称。

在标准代码模块中安装以下3个程序。

子 ShowMyForm() ' Variatus @STO 2020 年 2 月 21 日

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

结束子

子 RefreshMyForm() ' Variatus @STO 2020 年 2 月 21 日

Dim i As Integer

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

结束子

私有函数 FormIndex() 作为整数 ' Variatus @STO 2020 年 2 月 21 日

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

结束函数

此过程进入 ThisWorkbook 代码模块。

私人订阅 Workbook_Open() ' Variatus @STO 2020 年 2 月 21 日显示我的表格结束子

下面的过程进入用户窗体的代码模块。您可以调整列表框的填充方式以排除一些 sheet，但设置 V 变量以指示当前活动的 sheet.

很重要

私人订阅 UserForm_Initialize() ' Variatus @STO 2020 年 2 月 21 日

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

结束子

最后，这是您需要在列表框中列出的每个作品sheet的代码sheet中安装的程序。

私人订阅 Worksheet_Activate() ' Variatus @STO 2020 年 2 月 21 日
```
RefreshMyForm
```
结束子

现在，将它们放在一起：打开工作簿时，将调用过程 ShowMyForm。如果此后表单被意外删除，您可以通过调用相同的过程或 Workbook_Open 事件过程（也可以使用 F5 调用）来恢复它。如果重复调用 ShowMyForm，它将拒绝打开多个表单实例。

当窗体显示时，它的 Initialize 事件过程运行。此过程在列表框中列出 sheet 并设置当前 ActiveSheet。

当您更改 sheets 时，一个新的 sheet 被激活并且 Worksheet_Activate 事件发生。相关事件过程调用 ListBox 的 Initialize 事件，重置列表。

当您从列表框中 select 另一个 sheet 时，它会被用户窗体代码 sheet 中的此过程激活。不过，我想你已经有了。

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

突出显示列表框功能

Highlight Listbox Function

excel

vba

listbox