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

نقوم بكتابة معلومات عامة عن موظف ما في الخلايا من E2:E8
ثم بيانات ساعات العمل (حساب الوقت بين الدخول والخروج مثلاً)
بين الخلايا من M8:R18 .

ثم بيانات تتعلق بإجمالي الأجر من U8:Z18 كمرحلة أولى بين هذه البيانات المتفرقة أعمدة فارغة ...
نختار: من قائمة إدراج ... أشكال ... مستطيل ذو زاويتين مستديرتين من نفس الجانب ثم باستخدام Ctrl+D وبعد التنسيقات المطلوبة على الشكل من حيث توسيط الكتابة وحجم الخط وارتفاع وعرض الشكل ننسخه ليصبح 6 أشكال متناسقة

نحدد 3 منها لننقلها جانباً لتشكل القسم الفاتح من التبويبات الثلاثة وذلك باستخدام التعبئة المتدرجة إذ يكون لونها قريباً من الخلفية ...ستستخدم لتعطي تشغيل التبويب On بينما الداكنة لتعطي عدم التشغيل Off نرتبها أفقياً باستخدام المحاذاة إلى أسفل ثم نطابق كل شكل قاتم مع مثيله المضيء(الفاتح). تتم المطابقة بين كل شكلين بنفس المسمى باستخدام المحاذاة إلى اليمين .
كل تبويب مؤلف من شكلين قاتم وفاتح...في مربع الاسم نسمي كلاً منها باسم محدد لا تفصل بين كلماته فراغات وذلك لاستخدامها ضمن كتابة الأكواد لتشغيل الشكل المراد الضغط عليه بينما البقية يتم إيقاف تشغيلها فتظهر باللون الداكن ويختفي اللون الداكن في التبويب ذاته دون التبويبات الأخرى .
في المرحلة التالية وبعد ضبط الأشكال وتنسيق الجداول نذهب إلى المطور أو باستخدام الاختصار Alt+F11
ندرج موديول ثم نسميه TabMacrs
تكتب هذه الأكواد لتقوم بالدور الذي ذكرناه من قبل ..

Sub TabGen()
With Sheet1
Application.ScreenUpdating = False 'إيقاف تحديث الشاشة
.Shapes("GenOn").Visible = msoCTrue 'تفعيل هذا الشكل وتشغيله في حال الضغط عليه
.Shapes("GenOff").Visible = msoFalse 'يتم إخفاء هذا الشكل عندما نضغط على الشكل السابق

 .Shapes("TimOn").Visible = msoFalse 'إخفاء الأشكال الفاتحة المجاورة للشكل المضغوط عليه
.Shapes("TimOff").Visible = msoCTrue 'إظهار الشكل الغامق  طالما ظهر الشكل الفاتح السابق

.Shapes("EarOn").Visible = msoFalse 'إخفاء الأشكال الفاتحة المجاورة للشكل المضغوط عليه
.Shapes("EarOff").Visible = msoCTrue

.Range("D:K").EntireColumn.Hidden = False 'هذه الأعمدة المحددة ضمن النطاق ستظهر تحت التبويب فقط
.Range("L:AA").EntireColumn.Hidden = True 'هذه الأعمدة المحددة ضمن النطاق سيتم إخفاؤها
Application.ScreenUpdating = True 'تحديث الشاشة
End With
End Sub

Sub TabTime()
With Sheet1
Application.ScreenUpdating = False
.Shapes("TimOn").Visible = msoCTrue
.Shapes("TimOff").Visible = msoFalse

 
.Shapes("GenOn").Visible = msoFalse
.Shapes("GenOff").Visible = msoCTrue

.Shapes("EarOn").Visible = msoFalse
.Shapes("EarOff").Visible = msoCTrue

.Range("L:S").EntireColumn.Hidden = False
.Range("D:K,T:AA").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub
Sub TabEarn()
With Sheet1
Application.ScreenUpdating = False
.Shapes("EarOn").Visible = msoCTrue
.Shapes("EarOff").Visible = msoFalse

 
.Shapes("GenOn").Visible = msoFalse
.Shapes("GenOff").Visible = msoCTrue

.Shapes("TimOn").Visible = msoFalse
.Shapes("TimOff").Visible = msoCTrue

.Range("T:AA").EntireColumn.Hidden = False
.Range("D:S").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub

ولمنع اهتزاز الشاشة نكتب سطرأ قبل تنفيذ الكود وآخر بعده.
ملاحظة: دائماً نظهر عموداً قبل وبعد الخلايا المراد وضعها ضمن ناق التبويب .
وفي النهاية نقوم بتحديد هذه الأشكال لربطها بالماكرو لتصبح أزراراً للتبويبات
أرجو أن أكون بينت الأسلوب المتبع في هذا الموضوع
هذا الجهد المستطاع ...نسألكم الدعاء
والسلام عليكم ورحمة الله وبركاته.

تصميم تبويبات أفقية.rar