عمل قائمه منسدله باسماء الشيت

[إبراهيم ابوليله]

اريد ان اعمل قائمه منسدله باسما الشيت عن طريق الاكواد

بحيث حينا اختار اسم الصفحه يتم الذهاب اليها

ولكم جزيل الشكر

[elsedik]

جرب هذا الملف

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

قائمه منسدله باسما الشيت.rar

[الـعيدروس]

السلام عليكم

هذا الكود تحطه في حدث THISWORKBOOK

Private Sub Workbook_Open()

   For Each sh In ActiveWorkbook.Worksheets

   S_ALI = S_ALI & "," & sh.Name

   Next sh

   Range("A1").Select

   With Selection.Validation

	   .Delete

	   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S_ALI

   End With

End Sub

وهذا في حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

   If Not Intersect(Target, Range("A1")) Is Nothing Then

	   Worksheets(Target.Value).Select

   End If

End Sub

وهذا المرفق

SH_DATA.rar

[عبدالله المجرب]

السلام عليكم

جرب المرفق

فيه قائمة منسدلة متغيرة بأسماء الشيتات وعند اختيار شيت يتم الانتقال اليه في الخلية D4 في الورقة 1

==

قائمة منسدلة بأسماء الشيتات.rar

[عبدالله المجرب]

السلام عليكم

اخي ابو نصار

حل ممتاز جداً

ولي ملاحظة

ارى لو ان كود عمل القائمة في حدث تفعيل ورقة العمل التي بها القائمة المنسدلة لكان افضل حتى تصبح القائمة المنسدلة مرنة لو اضيفت شيتات جديدة

Private Sub Worksheet_Activate()

  For Each sh In ActiveWorkbook.Worksheets

   S_ALI = S_ALI & "," & sh.Name

   Next sh

   Range("A1").Select

   With Selection.Validation

		   .Delete

		   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S_ALI

   End With

End Sub

[الـعيدروس]

فعلا استاذ عبدالله كما تفضلت

وبرضه في حدث Thisworkbook

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

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

   For Each Sh In ActiveWorkbook.Worksheets

   S_ALI = S_ALI & "," & Sh.Name

   Next Sh

   Range("A1").Select

   With Selection.Validation

	   .Delete

	   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S_ALI

   End With

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next

   If Not Intersect(Target, Range("A1")) Is Nothing Then

	   Worksheets(Target.Value).Select

   End If

End Sub

[عبدالله المجرب]

السلام عليكم

اخي ابو نصار احسنت بارك الله في علمك

=========

لي ملاحظة على وضع الكود في حدث Thisworkbook

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

والله اعلم

[الـعيدروس]

يمكن تجنب الاوراق التي فيها بيانات

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

For s = 1 To Sheets.Count

If Sheets(s).Name = "ورقة2" Then Exit Sub

If Sheets(s).Name = "ورقة3" Then Exit Sub

Next

يصير الكود بهذا الشكل

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

For s = 1 To Sheets.Count

If Sheets(s).Name = "ورقة2" Then Exit Sub

If Sheets(s).Name = "ورقة3" Then Exit Sub

Next

   For Each Sh In ActiveWorkbook.Worksheets

   S_ALI = S_ALI & "," & Sh.Name

   Next Sh

   Range("A1").Select

   With Selection.Validation

	   .Delete

	   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S_ALI

   End With

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next

   If Not Intersect(Target, Range("A1")) Is Nothing Then

	   Worksheets(Target.Value).Select

   End If

End Sub

[إبراهيم ابوليله]

الاخ الكريم

مشكور لك على حسن متابعتك للطلب

ولكن عندى مشكله عند تنفيذ الكود يظهر خطأ رقم 424

ارفق اليك الشيت

وارجو عمل اللازم

ولو تفضلت ارجو منك شرح الخطأ الذى قمت انا به لتفدى الوقوع فى مثل هذه الاخطاء مره اخرى

ولك كل الشكر والتقدير والاحترام