如何在 Excel 中根据指定单元格值自动更改形状和大小？

如果我们想根据任何单元格中的值更改 Excel 中特定形状的大小，我们可以使用 VB 代码来实现。阅读本教程，了解如何根据 Excel 中指定的单元格值自动更改形状和大小。我们将分两部分进行讲解：第一部分是只更改一个形状，第二部分是同时更改多个形状。

为单个形状根据指定单元格值自动更改形状和大小

我们将向工作表添加 VBA 代码来完成我们的任务。让我们来看一个简单的过程，了解如何根据指定单元格值自动更改单个形状的大小。

步骤 1

让我们考虑一个类似于下图所示的 Excel 工作表。

现在右键单击工作表名称并选择“查看代码”以打开 VB 应用程序，然后将程序输入到文本框中，如下图所示。

程序

Private Sub Worksheet_Change(ByVal Target As Range)
   'Updated BY Nirmal
   On Error Resume Next
   If Target.Row = 1 And Target.Column = 1 Then
      Call SizeCircle("Hollow 1", Val(Target.Value))
   End If
End Sub
Sub SizeCircle(Name As String, Diameter)
   Dim xCenterX As Single
   Dim xCenterY As Single
   Dim xCircle As Shape
   Dim xDiameter As Single
   On Error GoTo ExitSub
   xDiameter = Diameter
   If xDiameter > 10 Then xDiameter = 10
   If xDiameter < 1 Then xDiameter = 1
   Set xCircle = ActiveSheet.Shapes(Name)
   With xCircle
      xCenterX = .Left + (.Width / 2)
      xCenterY = .Top + (.Height / 2)
      .Width = Application.CentimetersToPoints(xDiameter)
      .Height = Application.CentimetersToPoints(xDiameter)
      .Left = xCenterX - (.Width / 2)
      .Top = xCenterY - (.Height / 2)
   End With
ExitSub:
End Sub

代码中的形状名称为“Hollow 1”，“row = 1”和“column = 1”代表单元格 A1。

步骤 2

在使用 Alt + Q 退出 VBA 应用程序之前，将工作表另存为 VBA 模板。然后，每次我们更改单元格中的值时，单元格的形状都会自动更改，如下图所示。

为多个形状根据指定单元格值自动更改形状和大小

我们将向工作表添加 VBA 代码来完成我们的任务。让我们来看一个简单的过程，了解如何根据指定单元格值自动更改多个形状的大小。

步骤 1

让我们考虑一个类似于下图所示的 Excel 工作表。

现在右键单击工作表名称并选择“查看代码”以打开 VBA 应用程序，然后将程序输入到文本框中，如下图所示。

程序

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim xAddress As String
   On Error Resume Next
   If Target.CountLarge = 1 Then
      xAddress = Target.Address(0, 0)
      If xAddress = "A1" Then
         Call SizeCircle("Oval 1", Val(Target.Value))
      ElseIf xAddress = "B1" Then
         Call SizeCircle("Frame 2", Val(Target.Value))
      ElseIf xAddress = "C2" Then
         Call SizeCircle("Chord 3", Val(Target.Value))
      End If
   End If
End Sub

Sub SizeCircle(Name As String, Diameter)
   Dim xCenterX As Single
   Dim xCenterY As Single
   Dim xCircle As Shape
   Dim xDiameter As Single
   On Error GoTo ExitSub
   xDiameter = Diameter
   If xDiameter > 20 Then xDiameter = 20
   If xDiameter < 1 Then xDiameter = 1
   Set xCircle = ActiveSheet.Shapes(Name)
   With xCircle
      xCenterX = .Left + (.Width / 2)
      xCenterY = .Top + (.Height / 2)
      .Width = Application.CentimetersToPoints(xDiameter)
      .Height = Application.CentimetersToPoints(xDiameter)
      .Left = xCenterX - (.Width / 2)
      .Top = xCenterY - (.Height / 2)
   End With
ExitSub:
End Sub

在代码中，“Oval 1”、“Frame 2”和“Chord 3”是形状的名称，单元格 A1、B1 和 C2 分别决定它们的大小。