Excel 亲自动手制作宏插件实现聚光灯功能 一键开启关闭聚光灯效果
将自己做的Excel宏和Excel函数做成加载项插入到Excel功能区。
效果展示
聚光灯功能（俗称高亮行列，或者高亮当前行列）能够在我们选择单元格时，突出显示所在行和列，极大地提高数据处理和分析时的视觉效果与操作便利性。
WPS 的表格自带高亮行列功能，Excel 功能强大，却没有自带聚光灯功能，让人遗憾。为了弥补这个遗憾，特此利用宏插件在 Excel 中实现聚光灯效果，让高亮行列不再是 Excel 的短板。本文将详细介绍如何使用 Excel 的加载项实现 Excel 的聚光灯效果。
一、宏插件创建基础步骤-创建、激活、添加 Excel 加载项
（一）新建工作表
首先，打开 Excel 软件并新建一个工作表。在开发者工具中，打开 VB编辑器，在本工作薄的 VBAProject 插入新模块。如 图1 所示。
（二）编写聚光灯代码（缺少一个关键函数，后文有附录代码）
在上述创建模块后，双击模块，在空白处，写入聚光灯函数。2.1 代码块 是聚光灯函数参考。
（2.1）ToggleSpotlight 和 UpdateSpotlight 代码块
注：此处缺少 AddOrUpdateSelectionChangeEvent 函数。后文会附录上该函数的全部代码，只需要将后文的代码块粘贴到本段代码最后的空白处，继续以下操作即可。
Dim isSpotlightOn As Boolean ' 用于记录聚光灯效果是否开启的布尔变量
Dim eventAddedDict As Object ' 用于记录每个工作表是否已添加 Worksheet_SelectionChange 事件
Dim prevRngDict As Object ' 用于记录每个工作表的上一次选中的单元格区域
' 确保在每次使用前初始化字典
Function GetEventAddedDict() As Object
If eventAddedDict Is Nothing Then
Set eventAddedDict = CreateObject("Scripting.Dictionary")
End If
Set GetEventAddedDict = eventAddedDict
End Function
Function GetPrevRngDict() As Object
If prevRngDict Is Nothing Then
Set prevRngDict = CreateObject("Scripting.Dictionary")
End If
Set GetPrevRngDict = prevRngDict
End Function
' 获取当前工作表的唯一键（工作簿名称 + 工作表名称）
Function GetUniqueKey(ws As Worksheet) As String
GetUniqueKey = ws.Parent.Name & "!" & ws.Name
End Function
Sub ToggleSpotlight()
Dim ws As Worksheet
Set ws = ActiveSheet
' 确保字典已初始化
Dim dict As Object
Set dict = GetEventAddedDict()
Set prevDict = GetPrevRngDict()
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 如果字典中没有当前工作表的记录，则初始化为 False
If Not dict.Exists(uniqueKey) Then
dict(uniqueKey) = False
End If
' 如果是当前工作表首次启用聚光灯，则添加 Worksheet_SelectionChange 事件
If Not isSpotlightOn And Not dict(uniqueKey) Then
Call AddOrUpdateSelectionChangeEvent(ws)
dict(uniqueKey) = True
End If
' 切换聚光灯状态
If isSpotlightOn Then
isSpotlightOn = False
Cells.Interior.ColorIndex = xlColorIndexNone ' 清除所有单元格已设置的填充颜色（可选，根据需求决定是否保留此行）
Else
isSpotlightOn = True
' 首次启用时，立即更新聚光灯
Call UpdateSpotlight
End If
End Sub
Sub UpdateSpotlight()
If isSpotlightOn Then
Dim ws As Worksheet
Set ws = ActiveSheet
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 获取当前工作表的 prevRng
Dim prevRng As Range
If GetPrevRngDict().Exists(uniqueKey) Then
Set prevRng = GetPrevRngDict()(uniqueKey)
End If
' 清除之前的高亮
If Not prevRng Is Nothing Then
prevRng.EntireRow.Interior.ColorIndex = xlColorIndexNone
prevRng.EntireColumn.Interior.ColorIndex = xlColorIndexNone
End If
' 更新当前选中的区域
Set GetPrevRngDict()(uniqueKey) = Selection
Selection.EntireRow.Interior.Color = RGB(240, 243, 247)
Selection.EntireColumn.Interior.Color = RGB(240, 243, 247)
End If
End Sub
（三）保存宏插件文件-保存成Excel加载项
将包含宏代码的文件保存成 “.xlam” 格式。
选择文件，另存为，选择本电脑，点击路径后，在跳出的文件选框中，选择
Excel Add-in(*.xlam) 类型，后修改名称，如：自定义宏.xlam。如 图3 所示。
建议写英文，因为 Excel 可能存在中文乱码。CustomMacros.xlam 。
注：选择 Excel Add-in(*.xlam) 后一般会自动跳转到对应的文件路径，若没有，则需要自己手动放到对应的路径。
参考：C:\Users\xxxxxxx\AppData\Roaming\Microsoft\AddIns
（四）在 Excel 中激活插件
打开 Excel，点击 “选项”，然后进入 “插件” 菜单。在 “等待激活的插件” 中找到我们刚刚保存的 自定义宏.xlam 插件，选择 GO。
或者通过 Developer（开发工具） ，点击 Excel Add - ins，在弹出的对话框中勾选上述新保存的插件宏，以激活宏插件。如 图4 所示。
（五）自定义功能区-加载宏
点击文件，选项，在自定义功能区中，筛选宏。在右侧新创建选项卡，改名为：我的功能区，创建新组，命名为：工作表功能，随即用鼠标左键点击选定该组。
在左侧的宏中，找到上述激活的新宏，ToggleSpotlight ，若存在多个同名宏时，可以鼠标悬停查看宏路径，确保路径为上述添加的新宏。找到后，点击 ToggleSpotlight ，再点击 Add >> 即可添加到右侧自定义功能区。在选中右侧的新添加宏，选择重命名，选择好对应图标，点击确定即可。这样就可以在 Excel 的自定义功能区方便地访问和使用创建的宏了。
需要注意的是，一旦将文件保存成自动宏文件（.xlam 格式）之后，原文件无法直接打开修改。不过，如果若想修改宏插件代码，可以在新建文件后在 VBProject 进行修改操作，然后重新保存为新的宏插件文件并按照上述步骤激活使用。
二、实现思路
（一）创建聚光灯函数
该函数是聚光灯功能的核心部分，其主要作用是在选择单元格时，通过改变所选单元格所在行和列的样式，如背景颜色、字体颜色等，来突出显示该行和列，从而实现聚光灯效果。
Sub UpdateSpotlight()
If isSpotlightOn Then
Dim ws As Worksheet
Set ws = ActiveSheet
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 获取当前工作表的 prevRng
Dim prevRng As Range
If GetPrevRngDict().Exists(uniqueKey) Then
Set prevRng = GetPrevRngDict()(uniqueKey)
End If
' 清除之前的高亮
If Not prevRng Is Nothing Then
prevRng.EntireRow.Interior.ColorIndex = xlColorIndexNone
prevRng.EntireColumn.Interior.ColorIndex = xlColorIndexNone
End If
' 更新当前选中的区域
Set GetPrevRngDict()(uniqueKey) = Selection
Selection.EntireRow.Interior.Color = RGB(240, 243, 247)
Selection.EntireColumn.Interior.Color = RGB(240, 243, 247)
End If
End Sub
（二）创建转换开关函数
此函数用于控制聚光灯的开启和关闭。在开启聚光灯时，不仅要调用聚光灯函数实现突出显示效果，还需要保存当前单元格的原始格式。当关闭聚光灯时，根据之前保存的原始格式将单元格样式复原。
Sub ToggleSpotlight()
Dim ws As Worksheet
Set ws = ActiveSheet
' 确保字典已初始化
Dim dict As Object
Set dict = GetEventAddedDict()
Set prevDict = GetPrevRngDict()
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 如果字典中没有当前工作表的记录，则初始化为 False
If Not dict.Exists(uniqueKey) Then
dict(uniqueKey) = False
End If
' 如果是当前工作表首次启用聚光灯，则添加 Worksheet_SelectionChange 事件
If Not isSpotlightOn And Not dict(uniqueKey) Then
Call AddOrUpdateSelectionChangeEvent(ws)
dict(uniqueKey) = True
End If
' 切换聚光灯状态
If isSpotlightOn Then
isSpotlightOn = False
Cells.Interior.ColorIndex = xlColorIndexNone ' 清除所有单元格已设置的填充颜色（可选，根据需求决定是否保留此行）
Else
isSpotlightOn = True
' 首次启用时，立即更新聚光灯
Call UpdateSpotlight
End If
End Sub
（三）创建选择单元格后自动触发函数
为了实现每次选择单元格均能触发聚光灯效果，需要创建一个在选择单元格后自动触发的函数。这个函数可以在工作表的 SelectionChange 事件中调用聚光灯函数。
（四）创建写入自动触发函数代码的函数（2.1缺失的代码块）
该函数的功能是点击后，能将自动触发函数的代码写入到当前工作表。这样可以确保在不同的工作表中都能实现选择单元格自动触发聚光灯的效果。
注：代码块有一段注入运行文件函数的代码片段CustomMacros.xlam!UpdateSpotlight。
该片段需要按照第（一）章第（三）节中的保存加载项的名称对应好。不然会报错。
Sub AddOrUpdateSelectionChangeEvent(ws As Worksheet)
Dim wb As Workbook
Dim vbComp As Object ' VBComponent
Dim codeMod As Object ' CodeModule
Dim lineNum As Long, startLine As Long, endLine As Long
Dim eventProcFound As Boolean
Dim fullCode As String
' 获取当前激活的工作表和其所属的工作簿
Set wb = ws.Parent
' 检查是否允许访问 VBA 项目
If Not wb.VBProject Is Nothing Then
On Error Resume Next
Err.Clear
' 尝试获取 VBA 项目的引用
Set vbComp = wb.VBProject.VBComponents(ws.CodeName)
If Err.Number <> 0 Then
MsgBox "无法访问 VBA 项目。请确保宏安全设置允许编辑 VBA 代码。", vbExclamation
Exit Sub
End If
On Error GoTo 0
' 获取 CodeModule
Set codeMod = vbComp.CodeModule
' 定义要添加的完整代码（包括事件声明）
fullCode = _
"Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
" '调用加载宏中的UpdateSpotlight过程，假设加载宏名为MySpotlightAddIn（需要根据实际情况修改）" & vbCrLf & _
" Application.Run ""CustomMacros.xlam!UpdateSpotlight""" & vbCrLf & _
"End Sub"
' 检查是否已经存在该事件过程
eventProcFound = False
For lineNum = 1 To codeMod.CountOfLines
If InStr(1, codeMod.Lines(lineNum, 1), "Private Sub Worksheet_SelectionChange", vbTextCompare) > 0 Then
eventProcFound = True
startLine = lineNum
' 找到 End Sub 的位置
Do While lineNum <= codeMod.CountOfLines
If InStr(1, codeMod.Lines(lineNum, 1), "End Sub", vbTextCompare) > 0 Then
endLine = lineNum
Exit Do
End If
lineNum = lineNum + 1
Loop
Exit For
End If
Next lineNum
If Not eventProcFound Then
' 如果不存在，则直接添加完整的事件方法
codeMod.InsertLines codeMod.CountOfLines + 1, fullCode
MsgBox "已成功为 " & ws.Name & " 添加 Worksheet_SelectionChange 事件。", vbInformation
Else
' 如果存在，则替换现有方法的内容
With codeMod
.DeleteLines startLine, endLine - startLine + 1
.InsertLines startLine, fullCode
End With
MsgBox "已成功更新 " & ws.Name & " 中的 Worksheet_SelectionChange 事件。", vbInformation
End If
Else
MsgBox "当前工作簿没有 VBA 项目。", vbExclamation
End If
' 清理
Set codeMod = Nothing
Set vbComp = Nothing
Set wb = Nothing
End Sub
' 确保在工作簿打开时初始化字典
Private Sub Workbook_Open()
Call GetEventAddedDict
Call GetPrevRngDict
End Sub
' 处理新工作簿的情况
Private Sub Workbook_NewSheet(ByVal Sh As Object)
' 当新工作表被添加时，确保字典已初始化
Call GetEventAddedDict
Call GetPrevRngDict
End Sub
（五）代码合并（完整代码）
在当前工作表初次点击转换函数时，自动触发写代码函数。这样可以在用户首次开启聚光灯功能时，自动将选择单元格自动触发聚光灯的代码写入工作表，简化用户操作流程。
Dim isSpotlightOn As Boolean ' 用于记录聚光灯效果是否开启的布尔变量
Dim eventAddedDict As Object ' 用于记录每个工作表是否已添加 Worksheet_SelectionChange 事件
Dim prevRngDict As Object ' 用于记录每个工作表的上一次选中的单元格区域
' 确保在每次使用前初始化字典
Function GetEventAddedDict() As Object
If eventAddedDict Is Nothing Then
Set eventAddedDict = CreateObject("Scripting.Dictionary")
End If
Set GetEventAddedDict = eventAddedDict
End Function
Function GetPrevRngDict() As Object
If prevRngDict Is Nothing Then
Set prevRngDict = CreateObject("Scripting.Dictionary")
End If
Set GetPrevRngDict = prevRngDict
End Function
' 获取当前工作表的唯一键（工作簿名称 + 工作表名称）
Function GetUniqueKey(ws As Worksheet) As String
GetUniqueKey = ws.Parent.Name & "!" & ws.Name
End Function
Sub ToggleSpotlight()
Dim ws As Worksheet
Set ws = ActiveSheet
' 确保字典已初始化
Dim dict As Object
Set dict = GetEventAddedDict()
Set prevDict = GetPrevRngDict()
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 如果字典中没有当前工作表的记录，则初始化为 False
If Not dict.Exists(uniqueKey) Then
dict(uniqueKey) = False
End If
' 如果是当前工作表首次启用聚光灯，则添加 Worksheet_SelectionChange 事件
If Not isSpotlightOn And Not dict(uniqueKey) Then
Call AddOrUpdateSelectionChangeEvent(ws)
dict(uniqueKey) = True
End If
' 切换聚光灯状态
If isSpotlightOn Then
isSpotlightOn = False
Cells.Interior.ColorIndex = xlColorIndexNone ' 清除所有单元格已设置的填充颜色（可选，根据需求决定是否保留此行）
Else
isSpotlightOn = True
' 首次启用时，立即更新聚光灯
Call UpdateSpotlight
End If
End Sub
Sub UpdateSpotlight()
If isSpotlightOn Then
Dim ws As Worksheet
Set ws = ActiveSheet
' 获取当前工作表的唯一键
Dim uniqueKey As String
uniqueKey = GetUniqueKey(ws)
' 获取当前工作表的 prevRng
Dim prevRng As Range
If GetPrevRngDict().Exists(uniqueKey) Then
Set prevRng = GetPrevRngDict()(uniqueKey)
End If
' 清除之前的高亮
If Not prevRng Is Nothing Then
prevRng.EntireRow.Interior.ColorIndex = xlColorIndexNone
prevRng.EntireColumn.Interior.ColorIndex = xlColorIndexNone
End If
' 更新当前选中的区域
Set GetPrevRngDict()(uniqueKey) = Selection
Selection.EntireRow.Interior.Color = RGB(240, 243, 247)
Selection.EntireColumn.Interior.Color = RGB(240, 243, 247)
End If
End Sub
Sub AddOrUpdateSelectionChangeEvent(ws As Worksheet)
Dim wb As Workbook
Dim vbComp As Object ' VBComponent
Dim codeMod As Object ' CodeModule
Dim lineNum As Long, startLine As Long, endLine As Long
Dim eventProcFound As Boolean
Dim fullCode As String
' 获取当前激活的工作表和其所属的工作簿
Set wb = ws.Parent
' 检查是否允许访问 VBA 项目
If Not wb.VBProject Is Nothing Then
On Error Resume Next
Err.Clear
' 尝试获取 VBA 项目的引用
Set vbComp = wb.VBProject.VBComponents(ws.CodeName)
If Err.Number <> 0 Then
MsgBox "无法访问 VBA 项目。请确保宏安全设置允许编辑 VBA 代码。", vbExclamation
Exit Sub
End If
On Error GoTo 0
' 获取 CodeModule
Set codeMod = vbComp.CodeModule
' 定义要添加的完整代码（包括事件声明）
fullCode = _
"Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf & _
" '调用加载宏中的UpdateSpotlight过程，假设加载宏名为MySpotlightAddIn（需要根据实际情况修改）" & vbCrLf & _
" Application.Run ""CustomMacros.xlam!UpdateSpotlight""" & vbCrLf & _
"End Sub"
' 检查是否已经存在该事件过程
eventProcFound = False
For lineNum = 1 To codeMod.CountOfLines
If InStr(1, codeMod.Lines(lineNum, 1), "Private Sub Worksheet_SelectionChange", vbTextCompare) > 0 Then
eventProcFound = True
startLine = lineNum
' 找到 End Sub 的位置
Do While lineNum <= codeMod.CountOfLines
If InStr(1, codeMod.Lines(lineNum, 1), "End Sub", vbTextCompare) > 0 Then
endLine = lineNum
Exit Do
End If
lineNum = lineNum + 1
Loop
Exit For
End If
Next lineNum
If Not eventProcFound Then
' 如果不存在，则直接添加完整的事件方法
codeMod.InsertLines codeMod.CountOfLines + 1, fullCode
MsgBox "已成功为 " & ws.Name & " 添加 Worksheet_SelectionChange 事件。", vbInformation
Else
' 如果存在，则替换现有方法的内容
With codeMod
.DeleteLines startLine, endLine - startLine + 1
.InsertLines startLine, fullCode
End With
MsgBox "已成功更新 " & ws.Name & " 中的 Worksheet_SelectionChange 事件。", vbInformation
End If
Else
MsgBox "当前工作簿没有 VBA 项目。", vbExclamation
End If
' 清理
Set codeMod = Nothing
Set vbComp = Nothing
Set wb = Nothing
End Sub
' 确保在工作簿打开时初始化字典
Private Sub Workbook_Open()
Call GetEventAddedDict
Call GetPrevRngDict
End Sub
' 处理新工作簿的情况
Private Sub Workbook_NewSheet(ByVal Sh As Object)
' 当新工作表被添加时，确保字典已初始化
Call GetEventAddedDict
Call GetPrevRngDict
End Sub
（六）记录操作内容
分工作表和工作簿记录上次操作的内容，以便更好地还原当前工作表在聚光灯前的单元格格式。可以使用一些数据结构或者自定义对象来存储单元格的格式信息，如行高、列宽、背景颜色、字体样式等。在聚光灯关闭时，根据存储的信息准确地还原单元格格式。
扫一扫
1779
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
