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

ms excelmicrosoft technologiescomputers更新于 2024/9/21 2:52:17

当我们想要根据任意单元格中的值更改 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

代码中，Excel 中形状的名称为"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 分别决定它们的大小。