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

في Excel، تُستخدم الأشكال—مثل الدوائر والمستطيلات أو الرسومات المخصصة التي تُستخدم بشكل متكرر—لتحسين العرض البصري، أو في لوحات المعلومات، أو لتوضيح البيانات بفعالية. قد ترغب أحيانًا في جعل حجم الشكل يعكس ديناميكيًا القيمة الموجودة في خلية معينة؛ كأن تُنشئ مؤشرات تقدم، أو عروض حالة مرئية، أو حتى لتجعل تقاريرك أكثر تفاعلًا ووضوحًا. ومع ذلك، لا يوفّر Excel ميزة مدمجة تتيح ربط حجم الشكل تلقائيًا بمحتوى الخلية. يقدم هذا المقال طرقًا عملية لتغيير حجم الأشكال تلقائيًا استنادًا إلى قيمة خلية محددة، مما يساعدك على جعل مشاريع Excel الخاصة بك أكثر ديناميكية وجاذبية بصريًّا.

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

لجعل شكلٍ ما يضبط حجمه تلقائيًا وفقًا للقيمة المُدخلة في خلية معيّنة، يمكنك استخدام ماكرو VBA. يُعد هذا الأسلوب فعّالًا بشكل خاص إذا كنت ترغب في أتمتة عناصر لوحة المعلومات أو تسليط الضوء بصريًا على التغييرات في البيانات دون الحاجة إلى ضبط كل شكل يدويًا. وسيقوم كود VBA التالي بربط حجم الشكل بالقيمة الموجودة في خلية محددة ضمن ورقة العمل الخاصة بك.

Office Tab

التنقّل بعلامات التبويب بين Word وExcel وPowerPoint وغيرها الكثير — تمامًا كما في متصفح الويب، مع تبديل سلس داخل نافذة واحدة.

تنزيل مجانيمعرفة المزيد

يرجى اتباع الخطوات التالية:

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

2. في نافذةمايكروسوفت فيجوال بيسك للتطبيقات، انسخ والصق كود 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

الشرح والاحتياطات:

• في هذا الكود، يشير"Oval 2" إلى اسم الشكل الذي تنوي تغيير حجمه. تأكد من أن هذا الاسم يتطابق تمامًا مع الاسم الظاهر في لوحة التحديد (الصفحة الرئيسية > البحث والتحديد > لوحة التحديد).
• يتم تشغيل الكود فقط عند إجراء تغيير معيّن على الخليةA2 (وهي الصف 2، العمود 1). إذا أردت استخدام خلية مختلفة، يُرجى تحديث هذه القيم وفقًا لذلك.
• يتم تحديد حجم الشكل وفقًا لقيمة الخلية، والتي تمثّل القطر بالسنتيمترات. ويقوم الكود بتعيين حد أقصى للحجم قدره10 سموحد أدنى قدره1 سملتجنب مشكلات التحجيم المفرط.
• إذا أدخلت قيمةً خارج هذا النطاق (أقل من 1 أو أكثر من 10)، فسيتم ضبط حجم الشكل تلقائيًا ليصل إلى الحد الأقرب.
• إذا لم يُعثر على اسم الشكل المحدد أو كانت القيمة غير رقمية، سيتجاهل الكود الإجراء دون عرض أي رسالة خطأ.

بالنسبة للسيناريوهات التي تتطلب تغيير أحجام عدة أشكال تلقائيًا وفقًا للقيم الموجودة في خلايا مختلفة—مثل إنشاء سلسلة من المؤشرات أو عدادات مرئية—يمكنك توسيع حل 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. بعد تعديل الكود وحفظه، اضغطAlt+Q لإغلاق نافذةمايكروسوفت فيجوال بيسك للتطبيقاتوالعودة إلى ورقة العمل الخاصة بك.

الآن، في كل مرة تُغيّر فيها القيمة في الخلية A2، سيتغيّر حجم الشكل "Oval2" تلقائيًا وفي الوقت الفعلي. راجع لقطة الشاشة:

بالمثل، عند تحديث القيم في الخلايا A1 أو A2 أو A3، ستُعدِّل الأشكال "Oval 1" و"Smiley Face 3" و"Heart 2" أحجامها فورًا وفقًا للخلايا المرتبطة بها. انظر المثال أدناه:

تذكيرات إضافية:
- لا يُطبَّق التحجيم إلا عند تغيير القيم في الخلايا المحددة. فإذا قمت يدويًّا بتحريك الشكل أو تعديله بطريقة تخلّ بنقطة مرجعيته، فقد تحتاج إلى إعادة ضبط موضعه.
- تعمل القيم الرقمية فقط كما هو متوقع. وقد تؤدي الخلايا الفارغة أو الإدخالات النصية إلى تقليص الشكل إلى أقصى حدٍّ ممكن أو عدم تطبيق التحجيم بالشكل المتوقع.
- تأكد من تفعيل ماكروات Excel، إذ إن حلول VBA تتطلب تمكين أذونات الماكرو.

ملاحظة: يتوقف تكبير حجم الشكل تلقائيًا بمجرد أن تتجاوز قيمة الخلية 10 (الحد الأقصى المعيّن هو 10 سم). وبالمثل، تُضبط القيم الأقل من 1 تلقائيًا على الحد الأدنى (1 سم).

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

اقتراح ختامي:يوفّر أسلوب VBA تحجيمًا ديناميكيًا في الوقت الفعلي، وهو مثالي للوحات المعلومات التفاعلية والتقارير المعتمدة على البيانات. ومع ذلك، يتطلب من المستخدم فهم تسمية الأشكال وبيئة VBA، بالإضافة إلى حفظ المصنف كملف يدعم الماكرو ().xlsm) للحفاظ على الكود. ويُعد هذا الأسلوب الأنسب للحالات التي تكون فيها الأتمتة ضرورية ويكون استخدام وظائف الماكرو في المصنف مقبولًا.

تغيير حجم الشكل يدويًا عبر المرجع

إذا كنت بحاجة فقط إلى ضبط أحجام الأشكال بين الحين والآخر، أو فضّلت اتباع نهجٍ بسيط دون الاعتماد على الماكروات، فيمكنك ضبط حجم الشكل يدويًا ليتوافق مع قيمة الخلية حسب الحاجة. ويُعدّ هذا الأسلوب مثاليًا للحالات التي لا تتطلب أتمتة، أو عندما يكون استخدام الماكروات مقيدًا.

انقر على الشكل الذي تريد تغيير حجمه، ثم في جزءتنسيق الشكل (انقر بزر الماوس الأيمن على الشكل > الحجم والخصائص)، أدخل يدويًّا قيم العرض والارتفاع. يمكنك الرجوع إلى قياسات خليتك عند إدخال هذه القيم. وعلى الرغم من أن هذه الطريقة ليست تلقائية، إلا أنها مباشرة وفعّالة للتعديلات الفردية.

تلميح:مع هذه الطريقة، تأكد دائمًا من تحديث حجم الشكل يدويًّا عند تغيير قيم الخلايا، إذ لا يوجد ارتباط بين الشكل والخلية. وعلى الرغم من أن هذه الطريقة تجنّبك تحذيرات الأمان الناتجة عن الماكروات، إلّا أنها لا تدعم التحديثات البصرية الفورية.

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

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

أفضل أدوات الإنتاجية لمكتبتك

🤖	KUTOOLS AI مساعد: ثوّر تحليل البيانات استنادًا إلى:التنفيذ الذكي   |  إنشاء الكود|  إنشاء الصيغ المخصصة  |  تحليل البيانات وإنشاء المخططات البيانية|  استدعاء الوظائف المحسنة…
	الميزات الشائعة:البحث، التمييز أو وضع علامة على المكررات   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |  التقريب بدون استخدام الصيغة...
	بحث متقدم:VLookup متعدد المعايير  |  VLookup متعدد القيم  |   VLookup عبر أوراق متعددة   |   مطابقة غامضة....
	قائمة منسدلة متقدمة:إنشاء قائمة منسدلة بسرعة   |  قائمة منسدلة تابعة   |  قائمة منسدلة متعددة الاختيار....
	مدير الأعمدة:إضافة عدد محدد من الأعمدة|نقل الأعمدة|تبديل حالة ظهور الأعمدة المخفية|مقارنة النطاقات والأعمدة...
	ميزات مميزة:التركيز على الشبكة   |  عرض التصميم   |شريط الصيغ المحسن   | مدير الدفتر والورقة   |  مكتبة الموارد(نص تلقائي)|  أداة اختيار التاريخ   |  تجميع ورقات العمل  |  تشفير/فك تشفير الخلايا   | إرسال رسائل البريد الإلكتروني حسب القائمة   |  مرشح متقدم   |   تصفية خاصة(تصفية الخلايا التي تحتوي على خط عريض/مائل/يتوسطه خط...) ...
	أفضل 15 مجموعات الأدوات:12 أدواتالنصوص(إضافة نص،حذف الأحرف المحددة، ...)|   50+أنواعالمخططات البيانية(مخطط جانت، ...)|   40+ صيغعملية(حساب العمر بناءً على تاريخ الميلاد، ...)|   19 أدواتالإدراج(إدراج رمز QR،إدراج صورة من المسار، ...)|   12 أدواتالتحويل(تحويل إلى كلمات،تحويل العملة، ...)|   7 أدواتدمج وتقسيم(دمج متقدم للصفوف،تقسيم الخلايا، ...)|... وأكثر من ذلك

استخدم Kutools باللغة التي تفضلها – يدعم الإنجليزية والإسبانية والألمانية والفرنسية والصينية و40+ لغات أخرى!

عزِّز مهاراتك في Excel باستخدام Kutools لـ Excel، وعايش الكفاءة كما لم تفعل من قبل.يقدّم Kutools لـ Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية ووقت الحفظ.انقر هنا للحصول على الميزة التي تحتاجها أكثر من غيرها...

مزيد من التفاصيل حول Kutools لـ Excel...تنزيل مجاني...

---

يجلب Office Tab واجهة ذات علامات تبويب إلى Office، ويجعل عملك أسهل بكثير

• تمكّن من التحرير والقراءة باستخدام علامات التبويب في Word وExcel وPowerPoint، وPublisher وAccess وVisio وProject.
• افتح وأنشئ مستندات متعددة في علامات تبويب جديدة داخل النافذة نفسها، بدلاً من فتح نوافذ جديدة.
• يزيد إنتاجيتك بنسبة 50% ويوفّر لك مئات نقرات الفأرة كل يوم!

مزيد من التفاصيل حول Office Tab...تنزيل مجاني...

---

جميع الإضافات من Kutools في برنامج تثبيت واحد!

Kutools for Office حزمةٌ تحتوي على إضافاتٍ مخصصة لتطبيقات Excel وWord وOutlook وPowerPoint، إلى جانب Office Tab Pro، مما يجعلها الخيار المثالي للفِرق التي تعمل عبر تطبيقات Office.

• حزمة شاملة واحدة— إضافات Excel وWord وOutlook وPowerPoint بالإضافة إلى Office Tab Pro
• برنامج تثبيت واحد، ترخيص واحد— الإعداد خلال دقائق (جاهز لـ MSI)
• يعمل بشكل أفضل معًا— إنتاجية ميسَّرة عبر تطبيقات Office
• تجربة مجانية لمدة 30 يومًا بكامل الميزات— بدون تسجيل، بدون بطاقة ائتمان
• أفضل قيمة— وفِّر مقارنةً بشراء الإضافات بشكل منفصل

مزيد من التفاصيل حول Kutools for Office...تنزيل مجاني...