วิธีเปลี่ยนขนาดรูปร่างโดยอัตโนมัติตาม / ขึ้นอยู่กับค่าเซลล์ที่ระบุใน Excel

หากคุณต้องการเปลี่ยนขนาดรูปร่างโดยอัตโนมัติตามค่าของเซลล์ที่ระบุบทความนี้สามารถช่วยคุณได้

เปลี่ยนขนาดรูปร่างโดยอัตโนมัติตามค่าเซลล์ที่ระบุด้วยรหัส VBA

เปลี่ยนขนาดรูปร่างโดยอัตโนมัติตามค่าเซลล์ที่ระบุด้วยรหัส VBA

รหัส VBA ต่อไปนี้สามารถช่วยคุณในการเปลี่ยนขนาดรูปร่างตามค่าของเซลล์ที่ระบุในแผ่นงานปัจจุบัน กรุณาดำเนินการดังนี้

1. คลิกขวาที่แท็บแผ่นงานที่มีรูปร่างที่คุณต้องการเปลี่ยนขนาดจากนั้นคลิก ดูรหัส จากเมนูคลิกขวา

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน คัดลอกและวางรหัส VBA ต่อไปนี้ลงในหน้าต่างรหัส

รหัส VBA: เปลี่ยนขนาดรูปร่างโดยอัตโนมัติตามค่าเซลล์ที่ระบุใน Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", 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

หมายเหตุ: ในรหัส“รี 2” คือชื่อรูปร่างที่คุณจะเปลี่ยนขนาด และ แถว = 2, คอลัมน์ = 1 หมายความว่าขนาดของรูปร่าง“ วงรี 2” จะเปลี่ยนไปด้วยค่าใน A2 โปรดเปลี่ยนตามที่คุณต้องการ

สำหรับการปรับขนาดรูปร่างต่างๆโดยอัตโนมัติตามค่าของเซลล์ที่แตกต่างกันโปรดใช้รหัส VBA ด้านล่าง

รหัส VBA: ปรับขนาดรูปร่างต่างๆโดยอัตโนมัติตามค่าของเซลล์ที่ระบุใน Excel

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 = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", 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 > 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

หมายเหตุ:

3 กด อื่น ๆ + Q พร้อมกันเพื่อปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

จากนี้ไปเมื่อคุณเปลี่ยนค่าในเซลล์ A2 ขนาดของรูปร่าง Oval 2 จะเปลี่ยนโดยอัตโนมัติ ดูภาพหน้าจอ:

หรือเปลี่ยนค่าในเซลล์ A1, A2 และ A3 เพื่อปรับขนาดรูปร่างที่สอดคล้องกัน "Oval 1", "Smiley Face 3" และ "Heart 3" โดยอัตโนมัติ ดูภาพหน้าจอ:

หมายเหตุ: ขนาดรูปร่างจะไม่เปลี่ยนแปลงอีกต่อไปเมื่อค่าของเซลล์มากกว่า 10

บทความที่เกี่ยวข้อง:

• วิธีเพิ่มปลายเมาส์ให้เป็นรูปร่างบางอย่างใน Excel
• วิธีเติมรูปร่างด้วยสีพื้นหลังโปร่งใสใน Excel
• วิธีซ่อนหรือยกเลิกการซ่อนรูปร่างตามค่าเซลล์ที่ระบุใน Excel