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

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

قام بنشر

السلام عليكم

هذا الكود تحطه في حدث 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

  • Like 1
قام بنشر

السلام عليكم

جرب المرفق

فيه قائمة منسدلة متغيرة بأسماء الشيتات وعند اختيار شيت يتم الانتقال اليه في الخلية 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

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

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

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

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

زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information