Excel实战技巧:动态的笑脸图
时间:2022-03-29 19:41:39
无意中看到的一个技巧,非常有意思,稍作整理和修改,在这里和大家分享。
如下图1所示,在工作表中绘制了一个笑脸图,根据单元格H3中的数值来变换嘴唇的弧度。数值在0至50之间,是哭脸,超过50后就是笑脸了。
图1
在单元格H3中,设置了数据有效性,只能在该单元格中输入0至100之间的整数,如下图2所示。
图2
在笑脸所在的工作表模块中,输入代码:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler
Dim sh As Shape
Dim myMin As Double
Dim myMax As Double
Set sh = Shapes(“HappyFace”)
‘Excel 2003中,min=0.7181 max=0.8111
‘Excel 2007后,min=-0.04653 max0.04653
myMin = -0.04653
myMax = 0.04653
If Target.Address = “$H$3″ Then
Application.EnableEvents = False
sh.Adjustments.Item(1) _
= myMin + (myMax – myMin) * Target.Value/ 100
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox Err.Number & ” ” &Err.Description
GoTo exitHandler
End Sub
这里,添加了一段简单的代码,让单元格H3中的数字连续改变,从而实现笑脸不断变化,如下图3所示。
图3
下面,我们让笑脸随着分数的变化,颜色也同时发生变化,如下图4所示。
图4
相应的工作表模块代码如下:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler
Dim sh As Shape
Dim myMin As Double
Dim myMax As Double
Dim myColor As Long
Set sh = Shapes(“HappyFace”)
‘Excel 2003中, min=0.7181 max=0.8111
‘Excel 2007后, min=-0.04653 max=0.04653
myMin = -0.04653
myMax = 0.04653
If Target.Address = “$H$3″ Then
Application.EnableEvents = False
sh.Adjustments.Item(1) _
= myMin + (myMax – myMin) * Target.Value/ 100
‘修改形状颜色
‘小于60% 红色
‘60%- 90% 橙色
‘90%-100% 绿色
Select Case Target.Value
Case Is >= 90: myColor _
= RGB(146, 208, 80) ‘绿色
Case Is >= 60: myColor _
= RGB(255, 192, 0) ‘橙色
Case Else: myColor _
= RGB(255, 0, 0) ‘红色
End Select
sh.Fill.ForeColor.RGB = myColor
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox Err.Number & ” ” &Err.Description
GoTo exitHandler
End Sub
同样,我们也可以设置一段代码,让笑脸连续变化,如下图5所示。
图5
![](/images/zang.png)
![](/images/jiucuo.png)
猜你喜欢
为什么word中空格键变成点
![](https://img.aspxhome.com/file/2023/3/34203_0s.jpg)
LibreOffice Calc表格怎么设置边框?
![](https://img.aspxhome.com/file/2023/8/15228_0s.png)
word每次打开都要配置怎么办?word每次打开都要配置解决方法
![](https://img.aspxhome.com/file/2023/7/34067_0s.png)
windows hello指纹设置问题详解
![](https://img.aspxhome.com/file/2023/6/47046_0s.png)
利用Excel数据有效性实现单元格下拉菜单多种分类选项
Excel对比两列数据是否相同
![](https://img.aspxhome.com/file/2023/8/55178_0s.gif)
excel行高怎么统一设置
![](https://img.aspxhome.com/file/2023/5/55195_0s.gif)
word页脚横线怎么添加?
![](https://img.aspxhome.com/file/2023/6/35256_0s.jpg)
word中公式显示不完整该怎么办?word中的公式完整的显示出来的设置方法
![](https://img.aspxhome.com/file/2023/6/29106_0s.jpg)
Win10系统电脑更新后每次开机时间都变得很长怎么办?
![](https://img.aspxhome.com/file/2023/9/50469_0s.png)
Excel表格怎么添加批注?
![](https://img.aspxhome.com/file/2023/8/a154038_0s.jpg)
Excel如何套用现有的表格格式
![](https://img.aspxhome.com/file/2023/9/38529_0s.jpg)
在excel中如何用自动筛选找出位数错误的身份证号
excel功能区8个主选项卡使用基础纣
![](https://img.aspxhome.com/file/2023/0/a154440_0s.png)
Excel2010更改自动恢复文件的保存位置
![](https://img.aspxhome.com/file/2023/1/38781_0s.jpg)
word 表格外框线改为1.5磅双实线
![](https://img.aspxhome.com/file/2023/1/32451_0s.png)
Excel2007将内容复制到邻近单元格
excel截图工具使用基础教程
![](https://img.aspxhome.com/file/2023/7/a154777_0s.jpg)
excel如何识别空单元格和空白单元格?
![](https://img.aspxhome.com/file/2023/3/a142333_0s.png)