اخفاء واظهار بكود

[ابو ذكري]

السلام عليكم الاخوة الكرام

بعد التحية

مرفق ملف به كود إظهار كل الاوراق المخفية

في كل الاوراق ارتباط تشعبي في العمود A للانتقال الى اوراق العمل المطلوب العمل عليها

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

مثال

يتم العمل الان في ورقة العمل فترة اولى وببالنتهاء منها والانتقال مثلا الى ورقة العمل فترة ثالثة فبالضغط على ارتباط يتم الانتقال الى ورقة العمل فترة ثالثة واخفاء باقي الوراق

مع استثناء اول ورقة عمل في الكود بحيث تظل دائما ظاهرة في الشيت

نماذج.rar

[ابراهيم الحداد]

السلام عليكم ورحمة الله

ضع الكود الاول فى حدث الورقة 1

اما الكودين التاليين فضعهما فى موديول

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Call VisiblHide
End If
End Sub
Sub UnhideAll()
Dim j As Long
For j = 2 To Sheets.Count
If Sheets(j).Name <> "ورقة1" Then
Sheets(j).Visible = False
End If
Next
End Sub
Sub VisiblHide()
Dim cel As Range
Call UnhideAll
For Each cel In Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
If ActiveCell.Value = Sheets(cel.Value).Name Then
Sheets(cel.Value).Visible = True
End If
Next
End Sub

 

[ابو ذكري]

الأخ الكريم /

زيزو العجوز

جزاك الله خيرا على مرورك

تم عمل المطلوب

ولكن يتم اخفاء جميع الاوراق ما عدا الورقة الاولى فقط وفي حال استدعاء صفحة ما لا تظهر تظل مخفية كما هي

برجاء التطبيف على الملف ورفعة بعد التجربة للاهمية

وجعلة الله في ميزان حسناتكم

[ابراهيم الحداد]

السلام عليكم ورحمة الله

ضع هذا الكود فى حدث الورقة "ThisWorkBook"

واترك الكودين السابقين كما هما

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
Call VisiblHide
End If
End Sub

 

[ابو ذكري]

الاخ الفاضل

زيزو العجوز

جزاك الله خيرا على مرورك واهتمامك

برجاء مراجعة ما تم وارشادي للخطأ في التنفيذ

مع خالص التقدير

نماذج11.rar

[ابراهيم الحداد]

اخى الكريم

السلام عليكم ورحمة الله

كان هناك خلل بسيط فى الخلايا التى يوجد بها الهايبر لنك فى الورقلة1

فتم نسخ الهايبر من ورقة اخرى

بدلا منها

اليك الملف بعد التعديل

 

نماذج.rar

[ابو ذكري]

4 ساعات مضت, زيزو العجوز said:

اخى الكريم

السلام عليكم ورحمة الله

كان هناك خلل بسيط فى الخلايا التى يوجد بها الهايبر لنك فى الورقلة1

فتم نسخ الهايبر من ورقة اخرى

بدلا منها

اليك الملف بعد التعديل

 

نماذج.rar

مشكور أخي الكريم على مرورك واهتمامك

مع العلم مع نسخ الاكواد الى ملف أخر لا تعمل

فهل هناك اي شيء يجب علي تغييرة في الملفات التي ارغب في نقل الاكواد اليها لكي تعمل كما تعمل على ملفكم المرفق

مرفق محاولتي لنسخ الاكواد لملف أخر ( لم يعمل )

وتقبل تحياتي

 

 

نماذج.rar

تم تعديل أبريل 26, 2017 بواسطه ابو ذكري
إضافة مرفق

[ابو ذكري]

مشكور أخي الكريم على مرورك واهتمامك

مع العلم مع نسخ الاكواد الى ملف أخر لا تعمل

فهل هناك اي شيء يجب علي تغييرة في الملفات التي ارغب في نقل الاكواد اليها لكي تعمل كما تعمل على ملفكم المرفق

مرفق محاولتي لنسخ الاكواد لملف أخر ( لم يعمل )

وتقبل تحياتي

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اليك الملف بعد التنقيح

 

نماذج.rar

[ابو ذكري]

جزاكم الله خيرا وجعله في ميزان حسناتكم

جاري التجريب ومحاولة النسخ لملف أخر

وأسف على ازعاجكم بكثر الطلب والالحاح

ولكن هذا املنا فيكم وفي رواد المنتدي العبقري