先看一下视频效果: 下面详细讲解实现方法。 一、常见的聚光灯效果实现方法:“条件格式” VBA代码法1、条件格式设置:开始——条件格式——新建规则——使用公式确定单元格格式,输入公式:=OR(CELL('row')=ROW(),CELL('col')=COLUMN()),应用范围:=$1:$1048576。 注意复制粘贴公式后最好检查一下公式的最终效果,有时候粘贴公式时,某一步没操作好,系统会自动对公式添加一些双引号什么的,比如把公式变为='OR(CELL(''row'')=ROW(),CELL(''col'')=COLUMN())'等,会导致效果出不来,遇到这种情况时,不用慌,比照上面的公式,将多余的符号直接删掉即可。 2、VBA代码编辑:打开VBE——双击对应表单——粘贴代码: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.Calculate
Application.ScreenUpdating = True
End Sub
中间的两行代码任用一行即可。案例中行和列为相同的颜色,我们还可以设置为不同的颜色。 二、扩展1:设置聚光灯行、列及单元格为三种不同颜色。设置三次条件格式,方法同上,分别设置行、列、单元格的颜色,对应公式分别为: 行对应公式:=CELL('row')=ROW(); 列对应公式:=CELL('col')=COLUMN(); 单元格对应公式:=AND(CELL('row')=ROW(),CELL('col')=COLUMN())。 代码不用修改,设置过程及效果为: 三、纯代码方式聚光灯:不必设置条件格式,直接用代码实现单元格所在行列变颜色,还能实现多个单元格所在行列一起变色显示第一种方法当一次性选中了多个单元格时,仅能显示第一个单元格对应行列变色,通过直接在代码里设置行列变色效果的方式,可一步实现聚光灯效果,而不必设置条件格式。代码如下: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.CutCopyMode = False Then With Target .Parent.Cells.Interior.ColorIndex = xlNone .EntireRow.Interior.Color = vbGreen .EntireColumn.Interior.Color = vbCyan .Interior.Color = vbRed End With End If End Sub 条件语句设置为当进行复制粘贴时,聚光灯暂不启用。 效果为: 总的来说,相比第一种方法,纯代码法更简单,只是当想修改行列的显示颜色时,需要在代码中修改,不太方便,好在一般我们不会经常换颜色。 四、扩展2:聚光灯功能开启和关闭随时切换有时候,我们希望中途不想用聚光灯模式,我们可通过设置一个按钮来控制聚光灯功能的随时关闭和开启。效果为: 实现过程: 1、开发工具——插入——ActiveX控件复选框——在设计模式下右键复选框——查看代码,打开代码输入界面,粘贴下面的代码: Private Sub CheckBox1_Click()
If CheckBox1.Value = False Then
CheckBox1.Caption = '关'
ActiveSheet.Cells.Interior.ColorIndex = xlNone
Else
CheckBox1.Caption = '开'
End If
End Sub
2、在表单Worksheet_SelectionChange代码编辑区,修改代码: Private Sub Worksheet_SelectionChange(ByVal target As Range) If CheckBox1.Caption = '开' Then Call 聚光灯(target) End Sub Sub 聚光灯(rg As Range) If Application.CutCopyMode = False Then With rg .Parent.Cells.Interior.ColorIndex = xlNone .EntireRow.Interior.Color = vbGreen .EntireColumn.Interior.Color = vbCyan .Interior.Color = vbRed End With End If End Sub 五、扩展3:追光灯效果:实现代码分三部分: 1、开关设置代码: Private Sub CheckBox1_Click() If CheckBox1.Value = False Then CheckBox1.Caption = '关' On Error Resume Next ActiveSheet.Cells.Interior.ColorIndex = xlNone ActiveSheet.Shapes.Range(Array('箭头000')).Delete Else CheckBox1.Caption = '开' End If End Sub 2、调用代码: Private Sub Worksheet_SelectionChange(ByVal target As Range) If CheckBox1.Caption = '开' Then Call 追光灯(target) End If End Sub 3、功能代码: Sub 追光灯(rg As Range) On Error Resume Next rg.Parent.Cells.Interior.ColorIndex = xlNone ActiveSheet.Shapes.Range(Array('箭头000')).Delete ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 0, 0, _ rg.Left, rg.Top).Select Selection.ShapeRange.Name = '箭头000' With Selection.ShapeRange.Line .Visible = msoTrue .Weight = 10.25 End With With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorAccent1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0.6 End With rg.Interior.Color = vbRed End Sub |
|