اذهب الي المحتوي
أوفيسنا

احتاج تعديل في الكود الخاص باخفاء اعمدة حسب الشهور


إذهب إلى أفضل إجابة Solved by طارق محمود,

الردود الموصى بها

الاساتذة الافاضل

قمت بعمل كود يعمل علي عدد 20 صفحة والصفحات بنفس الشكل والترتيب للاعمدة ولكن تختلف فيها عدد الصفوف

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

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

طول الكود حيث قمت بعمله لعدد 2 شيت وكان طويل جدا فما بالكم بعدد 20 شيت

===============

شرح آليه الكود

عند فتح الملف يظهر فورم اختار منه الشهر من شهور السنة

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

ويتم ذلك في كل الصفحات والتي عددها 20  شيت

===============

ارجو منكم وضع كود اسهل واقصر لتنفيذ المطلوب ام ان الكو يعمل بالشكل الطبيعي ولا يمكن تغييره

اليكم الكود ثم الملف المرفق

الرقم السري لحماية الاوراق : 1


Private Sub CommandButton1_Click()
On Error Resume Next
    For i = 3 To Sheets.Count
        Sheets(i).Select
        ActiveSheet.Unprotect ("1")
    Next i

Sheets("Sheet1").Range("B1").Value = ComboBox1.Value
Application.ScreenUpdating = False
'=========
'اكواد لاظهار كافة الاعمدة اولا قبل اخفاء المطلوب
'ويجب وضعها باسم كل صفحة كما يلي
'=========
Sheets("ta3lem").Select
    Columns("B:U").Select
    Selection.EntireColumn.Hidden = False

Sheets("Amnn").Select
Columns("B:U").Select
    Selection.EntireColumn.Hidden = False

'************************
'اكواد لاخفاء الاعمدة حسب الشهر المطلوب
'ويتم وضعها لكل شهر في كل حساب او ورقة
'=========
If Sheets("Sheet1").Range("B1").Value = "يوليو" Then
    Sheets("ta3lem").Select
    Columns("D:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "اغسطس" Then
    Sheets("ta3lem").Select
    Columns("E:N").Select
    Selection.EntireColumn.Hidden = True
     Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "سبتمبر" Then
    Sheets("ta3lem").Select
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
     Columns("F:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "اكتوبر" Then
    Sheets("ta3lem").Select
    Columns("C:E").Select
    Selection.EntireColumn.Hidden = True
     Columns("G:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "نوفمبر" Then
    Sheets("ta3lem").Select
    Columns("C:F").Select
    Selection.EntireColumn.Hidden = True
     Columns("H:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "ديسمبر" Then
    Sheets("ta3lem").Select
    Columns("C:G").Select
    Selection.EntireColumn.Hidden = True
     Columns("I:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "يناير" Then
    Sheets("ta3lem").Select
    Columns("C:H").Select
    Selection.EntireColumn.Hidden = True
     Columns("J:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "فبراير" Then
    Sheets("ta3lem").Select
    Columns("C:I").Select
    Selection.EntireColumn.Hidden = True
     Columns("K:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "مارس" Then
    Sheets("ta3lem").Select
    Columns("C:J").Select
    Selection.EntireColumn.Hidden = True
     Columns("L:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "ابريل" Then
    Sheets("ta3lem").Select
    Columns("C:K").Select
    Selection.EntireColumn.Hidden = True
     Columns("M:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "مايو" Then
    Sheets("ta3lem").Select
    Columns("C:L").Select
    Selection.EntireColumn.Hidden = True
     Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "يونيو" Then
    Sheets("ta3lem").Select
    Columns("C:M").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
If Sheets("Sheet1").Range("B1").Value = "الاجمالي السنوي" Then
    Sheets("ta3lem").Select
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If

'***********************************************
'***********************************************
If Sheets("Sheet1").Range("B1").Value = "يوليو" Then
    Sheets("Amnn").Select
    Columns("D:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "اغسطس" Then
    Sheets("Amnn").Select
    Columns("E:N").Select
    Selection.EntireColumn.Hidden = True
     Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "سبتمبر" Then
    Sheets("Amnn").Select
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
     Columns("F:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "اكتوبر" Then
    Sheets("Amnn").Select
    Columns("C:E").Select
    Selection.EntireColumn.Hidden = True
     Columns("G:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "نوفمبر" Then
    Sheets("Amnn").Select
    Columns("C:F").Select
    Selection.EntireColumn.Hidden = True
     Columns("H:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "ديسمبر" Then
    Sheets("Amnn").Select
    Columns("C:G").Select
    Selection.EntireColumn.Hidden = True
     Columns("I:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "يناير" Then
    Sheets("Amnn").Select
    Columns("C:H").Select
    Selection.EntireColumn.Hidden = True
     Columns("J:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "فبراير" Then
    Sheets("Amnn").Select
    Columns("C:I").Select
    Selection.EntireColumn.Hidden = True
     Columns("K:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "مارس" Then
    Sheets("Amnn").Select
    Columns("C:J").Select
    Selection.EntireColumn.Hidden = True
     Columns("L:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "ابريل" Then
    Sheets("Amnn").Select
    Columns("C:K").Select
    Selection.EntireColumn.Hidden = True
     Columns("M:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "مايو" Then
    Sheets("Amnn").Select
    Columns("C:L").Select
    Selection.EntireColumn.Hidden = True
     Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'=============
If Sheets("Sheet1").Range("B1").Value = "يونيو" Then
    Sheets("Amnn").Select
    Columns("C:M").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
If Sheets("Sheet1").Range("B1").Value = "الاجمالي السنوي" Then
    Sheets("Amnn").Select
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("R:S").Select
    Selection.EntireColumn.Hidden = True
    Range("A5").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End If
'****************************************
'****************************************
On Error Resume Next
    For i = 4 To Sheets.Count
        Sheets(i).Select
        [c6:n3285].Locked = False
        ActiveSheet.Protect "1", True, True
    Next i
 
'=============
Application.ScreenUpdating = True
Sheets("Sheet1").Select
End
End Sub

اعتذر عن الاطاله ولكني احببت توضيح الصورة لكم كما اراها واريدها انا تلميذكم الصغير جدا

 

 

 

Copy of sssssss.rar

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

لغيت الأعمدة المساعدة وقللت طول المعادلات قليلا

وهذا هو الكود بعد التعديل

Private Sub CommandButton1_Click()
On Error Resume Next
    For i = 3 To Sheets.Count
        Sheets(i).Select
        ActiveSheet.Unprotect ("1")
    Next i


Sheet1.[B1].Value = ComboBox1.Value
Application.ScreenUpdating = False


mnth = Sheet1.[B1].Value   ' تسجيل إسم الشهر


' حلقة للورقتين 3،4 أي
' ta3lem,Amnn
For sh = 3 To 4
    
    With Sheets(sh)
        .Columns("B:U").EntireColumn.Hidden = False ' لاظهار كافة الاعمدة اولا
    
        'اكواد لاخفاء الاعمدة حسب الشهر المطلوب
        For cc = 3 To 16     ' أرقام أعمدة الشهور
            If .Cells(5, cc) = mnth Or cc = 15 Then GoTo 10
            Cells(5, cc).EntireColumn.Hidden = True.
10
        Next cc
    End With
Next sh


'****************************************
On Error Resume Next
    For i = 4 To Sheets.Count
        Sheets(i).Select
        [c6:n3285].Locked = False
        ActiveSheet.Protect "1", True, True
    Next i
'=============
Application.ScreenUpdating = True
Sheet1.Select
Me.Hide
End Sub
 
 

 

وهذا المرفق ، تفضل

sssssss.rar

  • Like 1
رابط هذا التعليق
شارك

الاستاذ القدير جدا / طارق محمو

اولا اشكر لسيادتكم سرعة استجابتكم لطلبي انا تلميذكم الصغير

ولكن الملف المرفق ليس به الكود الجديد  ولم يحذف منه الاعمدة المساعدة وايضا لم يتم تعديل المعادلة

اعتقد انه قد حدث خطأ في ارفاق الملف

 

ولكني عند تطبيق الكود علي ملفي المرفق ظهر لدي خطأ اليط صورته استاذي

اعتذر عن كثرة الطلبات

جزاك الله خيرا

 

Qz40Y.jpg

رابط هذا التعليق
شارك

استاذي الجليل / طارق محمود

بالفعل رووعة الرووعة ويعمل بشكل ممتاز علي الملف المرفق

وسأقوم بتجربته علي ملفي واخبرك بالنتيجة

 

ولكن لي طلب بسيط بالنسبة لكم

ارجو شرح المعادلة المستخدمة هذه حيث انها توفر الكثير والكثير بالفعل

=IF(OR($B$1="يوليو";$B$1="الاجمالي السنوي");0;SUM(C6:INDIRECT(ADDRESS(6;MATCH($B$1;$A$5:$P$5;0)-1))))

وهذه المعادلة ايضا

=SUM(C6:INDIRECT(ADDRESS(6;MATCH($B$1;$A$5:$P$5;0))))

واعتذر لكثرة طلباتي لكني اريد التعلم بحق

وارجو منك استاذي ان تشاهد موضوعي الآخر والاجابة علي استفساراتي

بعنوان  ((  هل للكود حد اقصي في الاسطر والاوامر .. وما هذه الرساله ؟؟  ))

 

http://www.officena.net/ib/index.php?showtopic=47661

جزاك الله خيرا

رابط هذا التعليق
شارك

استاذي العزيز

لك مني افضل تحيه شكر واجلال وتقدير

الكود رووعة الروعة

والشرح احلي واجمل

 

ولكن لي استفسار ماذا قصدت بكلمة الحواجز الموجودة في كود الحفظ في الملف

ورجاء ان تشاهد موضوعي الآخر ام انه ليس له رد

بعنوان  ((  هل للكود حد اقصي في الاسطر والاوامر .. وما هذه الرساله ؟؟  ))

 

http://www.officena....showtopic=47661

جزاك الله خيرا

 

رابط هذا التعليق
شارك

السلام عليكم

 

ولكن لي استفسار ماذا قصدت بكلمة الحواجز الموجودة في كود الحفظ في الملف

أخي الحبيب

ستجد في ملفك في حدث فتح الملف  الكود التالي

Private Sub Workbook_BeforeClose(Cancel As Boolean)
...
..
End Sub

وهو كود لم أتصفحه جيدا ولكنه كملخص يمنع تغيير الأكواد عند غلق الملف ، يجبر الاكسل علي ألا يحفظ تغييرات الكود

 

أما عن موضوعك الآخر (( هل للكود حد اقصي في الاسطر والاوامر .. وما هذه الرساله ؟؟  ))

أرد عليك بأنه لايوجد شيء بالكمبيوتر لانهائي >> كل شيء له حد أقصي

ولكنني لم أتعرض لهذا الطول من قبل

وتستطيع دائما تقليل طول الكود باستخدام أكواد فرعية والحلقات وأوامر كثيرة

لاتنزعج مع الممارسة ستجد ذلك شيقا

رابط هذا التعليق
شارك

شكرا استاذي القدير / طارق

واعتذر عن عدم الرد بسرعة نظرا لظروف السفر ولكني رأيت ردك علي ولكن من علي الموبايل ولم استطيع الرد

جزاك الله خيرا

ولي سؤال آخر استاذي القدير ساطرحه هنا وساقوم بعمل موضوع جديد باسمه

كيف يمكنني هنا في هذا الملف عمل زر يقوم بالحفظ عند الضغط عليه

حيث حاولت كثيرا ولكني اعتقد ان الحواجز الموجودة في الاكواد هي التي تعوق عمله

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information