果然是个坑-Excel vba 聚光灯。。。文末附上自己做的加载项（迷你版）

墨苏ycycc

开头容我吐槽下office官方，多少年了，聚光灯这么香的功能居然还要让我等万千Exceler操心，都什么鬼玩意儿策划
下面分享下我的开发测试心路历程（之所以选择开发，因为公司电脑不方便安装诸如某方格子等其他插件）
文章末尾会上xlam附件（源码可编辑）
各位看官前辈若有雅兴，可否不吝指点一二，小弟不胜感激
-------------------------------------------------------------------------------------------------------------------------------------------------------------
由于知道wps自带的阅读模式，眼热了很久很久。
近期出于工作原因，想在Excel里也实现类似功能便于日常数据查看（一切万恶的源头啊）。。。
于是乎开始资源整合（期待度娘搜现成，Then Ctrl+A，Ctrl+C，Ctrl+V）。。。

首先是第一个靓仔，条件格式+vba辅助
参考链接如下
巧用Excel制作炫酷聚光灯效果，数据查看太方便了 - 知乎 (zhihu.com)
可我不想每张表格都加条件格式（公司清单文件大几千份），好麻烦（这次真不是我懒），含泪pass......

接着靓仔二号，纯vba，很香
参考链接如下
Excel聚光灯加载宏【VBA】-百度经验 (baidu.com)
代码很简单，我很喜欢（实为水平有限，只看得懂简单的）
测试下来后只有一个问题，就是它：
Cells.Interior.Pattern = xlPatternAutomatic 用作一个恢复功能
原始单元格填充样式保留了！，牛X，双击666，但事情真那么简单嘛
网格线全没了。。。其余空白单元格全填充成了白色......原来你竟然是这样的保留。。。心态值-1分
既然Automatic不行，那0嘞？
Cells.Interior.Pattern = 0
咦？貌似不会整张表刷白，网格线还在，哈哈哈（仰天大笑3秒）
等等，我原来的填充嘞，不，整张表所有的填充嘞！嗯？。。。。。。沃了个大（文明用语）心态值-2分
无限套娃嘛这不是，鱼与熊掌不可兼得，强迫症果断不能忍，于是拿出我的大宝剑：
dim mycells as range
for each mycells in target.entirecolumn
   if ... then
      else
   end if
next
for each mycells in target.entirerow
   if ... then
      else
   end if
next
遍历，挨个设置，该Automatic的Automatic，该0的0，
结果当然是成功的，但是！无意间做了道菜，曰：《红烧CPU》，遂弃之，心态值-10086分
就在心态即将崩盘之余
淘到了一份宝藏贴，直接给跪了啊，这才是正真的聚光灯！

果然民间出大神，本站
链接在此
【重磅发布】：聚光灯——我的加载宏系列小工具【单元格小工具】之四-Excel VBA程序开发-ExcelHome技术论坛 -
大致概括下：
需调用windows API
建立自定义透明窗体，消息穿透，颜色透明
在自定义窗体上GDI绘图，生成异型窗体
依据选区设置异型窗体大小、确切位置
一顿骚操作下来实现完全脱离Excel的聚光灯效果，不影响原生表格数据。
有点惋惜的是大神并没有放出最终完全版，凭我目前三脚猫，没能力在他源码上去完善，只能空感叹。
当然，看了大神那么多骚操作，收获不小，也获得了灵感。

千呼万唤始出来
我的聚光灯-迷你版
在看了大神的操作后，仔细想了下《红烧CPU》；既然异型窗体可以通过绘图得到任意形状，那我的目标作用选区呢，
我给它缩小范围，不需要整行整列范围，可见窗口范围就行。
于是，终于等到了你，区域布尔运算：

Dim  lightrng As Range
Set lightrng = Intersect(ActiveWindow.VisibleRange, Union(Selection.EntireRow, Selection.EntireColumn))
先union并集，再intersect交集得到了可见范围的一个十字区域；大宝剑又要祭出了
将十字选区lightrng根据判断分成两个选区：
public nullcells as range  '无任何填充的空单元格
public colorcells as range '有底色的单元格，白色也算
'这两个是全局变量，后面要要用来套娃的。。。

  For Each mycells In lightrng
      If mycells.Row <> Selection.Row Or mycells.Column <> Selection.Column Then
      '这里我要吐槽，坑爹的微软，有并集、交集、唯独没补集（可能没找到，就当他没有了）
      '只能再加一层判断，导致我的if else 看着跟屎山一样。。。。。。心态值 -2^10086分
           If mycells.Interior.Pattern = xlNone Then
                  If nullcells Is Nothing Then
                     Set nullcells = mycells
                    Else
                     Set nullcells = Union(mycells, nullcells)
                  End If
           Else
                  If colorcells Is Nothing Then
                     Set colorcells = mycells
                    Else
                     Set colorcells = Union(mycells, colorcells)
                  End If
           End If
      End If
  Next
选区分好，前道工序做完，下面直接简单说原理逻辑（不码代码了，附件里有的。。。我真的不是懒）：
给lightrng设置条件格式（十字聚光灯出现在表格里了）
鼠标换个地方点一下，触发sheetselectionchange事件
nullcells.interior.Pattern=0
colorcells.interior.Pattern=1
set nullcells=nothing
set colorcells=nothing
给lightrng设置条件格式
鼠标换个地方点一下，触发sheetselectionchange事件
然后就是套娃，套娃，套娃。。。果然无限套娃才是永动机，至此可以解释为啥这个聚光灯是迷你版，因为CPU不能红烧

雪之花

不错不错，学习可加

369659139

我用wps.自带聚光灯.,转wps两年了.wps除了与office的兼容性.其他都完胜

leikaiyi123

我一直用附件中的加载项，很不错。RegSvr32 /s ExcelColorChange.dll

墨苏ycycc

雪之花 发表于 2023-3-3 08:58
不错不错，学习可加

学无止境

墨苏ycycc

369659139 发表于 2023-3-3 09:56
我用wps.自带聚光灯.,转wps两年了.wps除了与office的兼容性.其他都完胜

确实，wps是懂国人的

墨苏ycycc

leikaiyi123 发表于 2023-3-3 10:33
我一直用附件中的加载项，很不错。

这个应该怎么用呀，com加载项好像不行，我的是2016版

leikaiyi123

墨苏ycycc 发表于 2023-3-3 11:51
这个应该怎么用呀，com加载项好像不行，我的是2016版

RegSvr32 /s ExcelColorChange.dll

zpy2

web版表格聚光灯。。。

dxq92

一个特定条件的条件格式的方式

1. Public WithEvents app As Excel.Application
   
2. 
   
3. Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
4.    
   
5.     '选中区域变化时变化聚光灯
   
6.     If f1 = True And Target.Columns.Count <> Cells.Columns.Count And Target.Rows.Count <> Cells.Rows.Count Then '选中整行 和 整列 时不显示
   
7.         On Error Resume Next
   
8.         
   
9.         focuslamp.Delete '方法2
   
10.         
    
11.         Set focuslamp = Union(Target.EntireRow, Target.EntireColumn).FormatConditions.Add(Type:=xlExpression, Formula1:="=true=true")
    
12.         
    
13.         focuslamp.Interior.Color = RGB(204, 255, 204)
    
14.         
    
15.     End If
    
16.    
    
17. End Sub
    
18. 
    
19. Private Sub app_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    
20.     Call DelFocuslamp(Wb)
    
21. End Sub
    
22. 
    
23. Private Sub app_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    
24.     Call DelFocuslamp(Wb)
    
25. End Sub
    
26. 
    
27. Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
28.     Call DelFocuslamp(Wb)
    
29. End Sub
    
30. 
    
31. Sub DelFocuslamp(ByVal Wb As Workbook)
    
32.     '打印/关闭/保存 时 如果聚光灯位于关闭关键 则需要删除
    
33.     On Error Resume Next
    
34.     If Not focuslamp Is Nothing Then
    
35.         If focuslamp.Parent.Parent.Parent.Name = Wb.Name Then
    
36.             focuslamp.Delete '方法2
    
37.             Set focuslamp = Nothing
    
38.         End If
    
39.     End If
    
40.    
    
41.     'Wb.Save '如果保存此行 不适宜自动保存
    
42. End Sub
    
43. 
    

复制代码

在没有删除干净的时候

1. Sub 清除聚光灯()
   
2.     Dim wb1 As Workbook
   
3.     Dim sht As Worksheet
   
4.     Set wb1 = ActiveWorkbook
   
5.     聚光灯_关闭
   
6.     On Error Resume Next
   
7.    
   
8.     For Each sht In wb1.Sheets
   
9.         Err.Clear
   
10.         fcount = 0
    
11.         fcount = sht.Cells.FormatConditions.Count
    
12.         If fcount > 0 Then
    
13.             For Each f In sht.Cells.FormatConditions
    
14.                 If f.Formula1 = "=TRUE=TRUE" Then
    
15.                     f.Delete
    
16.                 End If
    
17.             Next
    
18.         End If
    
19.     Next
    
20.    
    
21. End Sub

复制代码