如何在 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 分別決定它們的大小。