無意中看到的一個技巧，非常有意思，稍作整理和修改，在這里和大家分享。
如下圖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
