excel聚光灯设置的vba实现

Answer 1

您好，方法
1
先看效果图，本聚光灯的效果是修改的单元格的背景样式，不会改变原有的底色和边框。
2
注意，由于水平有限，制作出来的聚光灯有一个缺陷，使用后会将未使用的单元格添加白色背景，如果您的数据使用了边框和底色，将不会受到影响，从下图可以看出，没有使用到的单元格的网格线看不到了。如果对这个有介意的，可以忽略本方法，网络上有成熟的插件，使用起来效果会更好。
第一步：新建一个Excel，名称自己喜欢就好。右击标签页-查看代码，打开代码编辑窗口。
第二步：在左侧工程界面右击-添加-类模块
Excel聚光灯加载宏【VBA】
第三步：双击打开类模块编辑窗口，复制如下代码到类模块
Public WithEvents app As Excel.Application
Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Cells.Interior.Pattern = xlPatternAutomatic
Selection.EntireRow.Interior.Pattern = xlPatternGray8
Selection.EntireRow.Interior.PatternColor = B
Selection.EntireColumn.Interior.Pattern = xlPatternGray8
Selection.EntireColumn.Interior.PatternColor = B
Selection.Interior.Pattern = xlPatternAutomatic'上面是修改背景样式，一般很少使用这种格式，所以几乎不存在勿修改的情况
End Sub
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
Set xlapp.app = Nothing
End Sub
第四步：在左侧工程窗口，右击-添加-模块。
第五步：双击模块，复制如下代码到模块中
Public lampcolor As VariantPublic B As Variant
Public xlapp As New 类1
Sub auto_open()
Set xlapp.app = Application
End Sub
Sub auto_close()
Set xlapp.app = Nothing
' Cells.Interior.ColorIndex = xlNone
Cells.Interior.Pattern = xlPatternAutomatic
End Sub
Sub colorselection()
On Error GoTo 10
A = ActiveWorkbook.Colors(1)
Application.Dialogs(xlDialogEditColor).Show (1)
B = ActiveWorkbook.Colors(1)
ActiveWorkbook.Colors(1) = A
10 ActiveWorkbook.ResetColors
End Sub
第六步：Excel 文件-另存为-加载宏文件
地址就为默认地址就好，默认地址是一个隐藏文件夹，放在这里安全一些
Excel聚光灯加载宏【VBA】
第七步：显示开发工具标签页，文件-选项-自定义功能区，右侧勾选开发工具。
第八步：开发工具-加载项-浏览，找到刚刚另存为的加载宏，确认！
第九步：新建一个Excel，文件-选项-自定义功能区，从图中4的位置下拉选择宏；在图中5位置新建一个选项卡（可以在9位置重命名），新建一个组（也可以重命名），然后在图中7的位置依次将三个宏添加到新建的组中。
第十步：发现Excel工具栏中多了一个标签页，点击open就可以使用了，点击close就关闭，点击colorselection就可以选择颜色。
每当打开一个Excel文件时，默认都是关闭的，防止误修改。
搞定！
以后每打开一个Excel都可以使用聚光灯啦。