كيفية تغيير حجم الشكل تلقائيًا بناءً على / اعتمادًا على قيمة الخلية المحددة في Excel؟

إذا كنت تريد تغيير حجم الشكل تلقائيًا بناءً على قيمة خلية محددة ، فيمكن أن تساعدك هذه المقالة.

تغيير حجم الشكل تلقائيًا استنادًا إلى قيمة الخلية المحددة برمز VBA

تغيير حجم الشكل تلقائيًا استنادًا إلى قيمة الخلية المحددة برمز VBA

يمكن أن تساعدك التعليمات البرمجية لـ VBA التالية في تغيير حجم شكل معين بناءً على قيمة الخلية المحددة في ورقة العمل الحالية. الرجاء القيام بما يلي.

1. انقر بزر الماوس الأيمن فوق علامة تبويب الورقة بالشكل الذي تريد تغيير الحجم ، ثم انقر فوق عرض الرمز من قائمة النقر بزر الماوس الأيمن.

2. في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، انسخ والصق رمز فبا التالي في نافذة التعليمات البرمجية.

رمز 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

ملاحظات: في الكود ، "البيضاوي شنومكس"هو اسم الشكل الذي ستقوم بتغيير حجمه. و الصف = شنومكس, العمود = 1 يعني أن حجم الشكل "البيضاوي 2" سيتغير بالقيمة في A2. الرجاء تغييرها كما تريد.

لتغيير الحجم التلقائي لأشكال متعددة استنادًا إلى قيم خلايا مختلفة ، يرجى تطبيق رمز 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 = "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 مفاتيح في نفس الوقت لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

من الآن فصاعدًا ، عند تغيير القيمة في الخلية A2 ، سيتم تغيير حجم الشكل البيضاوي 2 تلقائيًا. انظر لقطة الشاشة:

أو قم بتغيير القيم الموجودة في الخلية A1 و A2 و A3 لتغيير حجم الأشكال المقابلة "البيضاوي 1" و "الوجه المبتسم 3" و "القلب 3" تلقائيًا. انظر لقطة الشاشة:

ملاحظات: لن يتغير حجم الشكل بعد الآن عندما تكون قيمة الخلية أكبر من 10.

مقالات ذات صلة:

• كيفية إضافة مؤشر الفأرة إلى شكل معين في Excel؟
• كيفية ملء شكل بلون خلفية شفاف في Excel؟
• كيفية إخفاء أو إظهار شكل معين بناءً على قيمة خلية محددة في إكسيل؟