أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
محمدعبدالسلام لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة طلب مساعدة اريد في كل 4 من شهر يتم نسح الاسم من عمود الى عمود اكسيل اسئله واجابات


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





تعديل كود اخفاء اعمدة فارغة

السلام عليكم. اخوتي الرجاء مساعدتي في التعديل على كود اخفاء اعمدة فارغة من البيانات لاني لم استطع تطبيقه على هذا الملف و ..


موضوع مغلق


22-12-2021 02:06 مساء
وليد 99999
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-06-2021
رقم العضوية : 22562
المشاركات : 69
الجنس : ذكر
تاريخ الميلاد : 1-1-1999
يتابعهم : 3
يتابعونه : 0
قوة السمعة : 32
 offline 

السلام عليكم.
اخوتي الرجاء مساعدتي في التعديل على كود اخفاء اعمدة فارغة من البيانات لاني لم استطع تطبيقه على هذا الملف ولا اعرف اين الغلط فيه .
واتمنى من الاخ والخبير الذي يقوم بالتعديل اتمنى ان يجعل الجدول تظهر فيه الاعمدة تلقائيا في حال وجود بيانات في الجدول الاصلي لان هذا الجدول ياخذ بياناته من جدول اخر وتختفي تلقائيا في حال عدم وجود بيانات في الجدول الاصلي. لكم مني جزيل الشكر والاحترام .
 
 
  تعديل كود موجود.xlsm   تحميل xlsm مرات التحميل :(8)
الحجم :(126.675) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام
جرب التعديل التالي عله يفي بالغرض إن شاء الله
Sub Button11_Click()
    Dim ws As Worksheet, cell As Range, lr As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("الرئيسية")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        With ws
            .Range("C6:AY6").EntireColumn.Hidden = False
            For Each cell In .Range("C4:AY47")
                If cell.EntireColumn.Hidden = True Then
                    cell.EntireColumn.Hidden = False
                ElseIf cell.Value = "" Then
                    cell.EntireColumn.Hidden = True
                End If
            Next cell
            For Each cell In .Range("C6:AY6").Cells
                If cell.Value = 0 Then cell.EntireColumn.Hidden = True
            Next cell
        End With
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub
عرض الإجابة




22-12-2021 04:49 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل كود اخفاء اعمدة فارغة
وعليكم السلام
جرب التعديل التالي عله يفي بالغرض إن شاء الله
Sub Button11_Click()
    Dim ws As Worksheet, cell As Range, lr As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("الرئيسية")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        With ws
            .Range("C6:AY6").EntireColumn.Hidden = False
            For Each cell In .Range("C4:AY47")
                If cell.EntireColumn.Hidden = True Then
                    cell.EntireColumn.Hidden = False
                ElseIf cell.Value = "" Then
                    cell.EntireColumn.Hidden = True
                End If
            Next cell
            For Each cell In .Range("C6:AY6").Cells
                If cell.Value = 0 Then cell.EntireColumn.Hidden = True
            Next cell
        End With
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

22-12-2021 05:14 مساء
مشاهدة مشاركة منفردة [2]
وليد 99999
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-06-2021
رقم العضوية : 22562
المشاركات : 69
الجنس : ذكر
تاريخ الميلاد : 1-1-1999
يتابعهم : 3
يتابعونه : 0
قوة السمعة : 32
 offline 
look/images/icons/i1.gif تعديل كود اخفاء اعمدة فارغة
المشاركة الأصلية كتبت بواسطة: YasserKhalil
وعليكم السلام
جرب التعديل التالي عله يفي بالغرض إن شاء الله
Sub Button11_Click()
    Dim ws As Worksheet, cell As Range, lr As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("الرئيسية")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        With ws
            .Range("C6:AY6").EntireColumn.Hidden = False
            For Each cell In .Range("C4:AY47")
                If cell.EntireColumn.Hidden = True Then
                    cell.EntireColumn.Hidden = False
                ElseIf cell.Value = "" Then
                    cell.EntireColumn.Hidden = True
                End If
            Next cell
            For Each cell In .Range("C6:AY6").Cells
                If cell.Value = 0 Then cell.EntireColumn.Hidden = True
            Next cell
        End With
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub


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

22-12-2021 05:33 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل كود اخفاء اعمدة فارغة
بارك الله فيك أخي الكريم
يمكنك إضافة سطر قبل الطباعة تنفذ فيه الطباعة بالكود يليه الكود الذي تستخدمه ثم بعد الطباعة تضع سطر يظهر الأعمدة المخفية. ادرس الكود جيداً وستجد في الكود أسطر تساعدك على إكمال ما تريد.
لا تنسى أن المنتدى تعليمي ولابد من أن تحاول في سبيل الوصول لحل المشكلة.

22-12-2021 06:45 مساء
مشاهدة مشاركة منفردة [4]
وليد 99999
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-06-2021
رقم العضوية : 22562
المشاركات : 69
الجنس : ذكر
تاريخ الميلاد : 1-1-1999
يتابعهم : 3
يتابعونه : 0
قوة السمعة : 32
 offline 
look/images/icons/i1.gif تعديل كود اخفاء اعمدة فارغة
المشاركة الأصلية كتبت بواسطة: YasserKhalil
بارك الله فيك أخي الكريم
يمكنك إضافة سطر قبل الطباعة تنفذ فيه الطباعة بالكود يليه الكود الذي تستخدمه ثم بعد الطباعة تضع سطر يظهر الأعمدة المخفية. ادرس الكود جيداً وستجد في الكود أسطر تساعدك على إكمال ما تريد.
لا تنسى أن المنتدى تعليمي ولابد من أن تحاول في سبيل الوصول لحل المشكلة.

Sub Button1231_Click()
    Dim ws As Worksheet, cell As Range, lr As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets("ÇáÑÆíÓíÉ")
        On Error Resume Next
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        With ws
            .Range("C6:AY6").EntireColumn.Hidden = False
            For Each cell In .Range("C4:AY47")
                If cell.EntireColumn.Hidden = True Then
                    cell.EntireColumn.Hidden = False
                ElseIf cell.Value = "" Then
                    cell.EntireColumn.Hidden = True
                End If
            Next cell
            Range("C4:AY47").PrintPreview
            For Each cell In .Range("C6:AY6").Cells
                If cell.Value = 0 Then cell.EntireColumn.Hidden = False
            Next cell
         End With
         
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

جزاك الله خيرا 
هذا ماقمت بكتابته فهل هذه الاضافة صحيحة ام فيها خطا 

23-12-2021 03:46 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل كود اخفاء اعمدة فارغة
قم بتجربة الكود الذي قمت بالإضافة عليه عندك وتأكد من أن الكود يؤدي المطلوب ، أما إذا ظهر خطأ انقر على Debug وسنقلك للسطر الذي به الخطأ إذا وجد.



الكلمات الدلالية
تعديل ، اخفاء ، اعمدة ، فارغة ،


 










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

الساعة الآن 07:30 مساء