Excel实战技巧84：让形状生动起来

fanjy

发布于 2020-07-24 10:07:36

5370

文章被收录于专栏：完美Excel完美Excel

学习Excel技术，关注微信公众号：

excelperfect

我们可以将《Excel实战技巧83：制作动态的笑脸图》中介绍的技术运用到其他类型的形状中。下面再举一个例子，如下图1所示。

图1

对单元格H3设置数据有效性如下图2所示。

图2

在形状所在的工作表模块中，输入代码：

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo errHandler
  Dim sh As Shape
  Dim myColor As Long
  Dim lAdj As Long
  Set sh = Shapes("Partial Circle 1")
 
  If Target.Address = "$H$3" Then
    Application.EnableEvents = False
    sh.Adjustments.Item(1) = 0
 
    Select Case Target.Value
      Case 0: lAdj = 0
      Case Else:  lAdj = -(360 - (360 * Target.Value))
    End Select
   
    sh.Adjustments.Item(2) = lAdj
 
    '修改形状颜色
    Select Case Target.Value
      Case Is >= 0.85: myColor _
        = RGB(169, 208, 142)  '绿色
      Case Is >= 0.75: myColor _
        = RGB(255, 255, 0)  '黄色
      Case Is >= 0.5: 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

我们可以添加一小段代码，让这个图动起来，如下图3所示。