عمل قائمة بأسماء شيتات الملف

[ابو العلاء]

الخوة خبراء المنتدى اريد ظهور اسماء الشيتات داخل اللست بوكس وعند اضافة

شيت اخر يظهر ايضا داخل اللست بوكس وعند الاشارة الى اسم الشيت يذهب الى الشيت المطلوب

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

Book1.rar

[الـعيدروس]

السلام عليكم

الذي في المرفق لااعتقد ان تقدر تربطه على تنفيذ

ولاكن انشاء ليست بوكس من عناصر تحكم Activex

وحط هذا الكود في حدث الصفحة

Private Sub ListBox1_Click()

Dim sh As Worksheet

With ListBox1

Set sh = Sheets(.Column(0))

End With

sh.Activate

End Sub

Private Sub ListBox1_LostFocus()

On Error Resume Next

Dim C_ALI As Integer

For C_ALI = 1 To ActiveWorkbook.Sheets.Count

    ActiveSheet.ListBox1.AddItem ActiveWorkbook.Sheets(C_ALI).Name

Next

C_ALI = Null

End Sub

تم تعديل ديسمبر 28, 2011 بواسطه alidroos

[ابو العلاء]

اخي الكريم شكرا لك ممكن اضافة مثال على ذلك ( اذا امكن اين توجد قائمة عناصر تحكم Activex)

[الـعيدروس]

اطلع على المرفق

fffd.rar

[ابو العلاء]

اخي الكريم وضعت الكود في حدث الصفحة ولم يفلح معي انا ما فيها ازعاج ممكن مثال بداخله الكود

[الـعيدروس]

تفضل

واي ملاحظات انا موجود

تحياتي

SH_ALI.rar

[ابو العلاء]

اخي الكريم مشكور بس اذا ما فيها غلبة ممكن يكون الشيت اكسل 2003

[أ / محمد صالح]

بارك الله لك أخي العيدروس (أبا نصار)

وهذه مساهمة من العبد لله لحل مثل هذا المشكل

ضع هذا الكود في الجزء الخاص بالمصنف thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Dim ws As Worksheet, sheetlist As String

For Each ws In ActiveWorkbook.Sheets

sheetlist = sheetlist & ws.Name & ","

Next

With ActiveSheet.Range("a2").Validation

	.Delete

	.Add xlValidateList, Formula1:=Left(sheetlist, Len(sheetlist) - 1)

End With

End Sub

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

If Range("a2").Value <> "" Then Sheets(Range("a2").Value).Select

End Sub

وهو لوضع قائمة بأسماء الشيتات في الخلية a2 من كل الشيتات

وبفضل الله القائمة ذاتية التحديث بحيث إذا تمت إضافة شيت أو حذف شيت يظهر أو يختفي من القائمة في الحال

وعند الاختيار من القائمة يتم الانتقال للشيت الذي تم اختياره

جرب أخي وأخبرني بالنتيجة

[ابو العلاء]

الشكر للجميع ولكن استاذي الكريم mas123 ممكن ان تكون الخلية التي يتم اختيار اسم الشيت منها في ورقة رقم واحد فقط حيث اني لاحظت وعند التقل بين الاوراق اجد ان الخلية a2 تحمل نفس الخصائص فيي جميع الاوراق

[أ / محمد صالح]

هذا ما قلته أنا فلربما يحتاج ذلك أحد الإخوة

ولعمل ما تريد استبدل هذا السطر

With ActiveSheet.Range("a2").Validation

بالتالي

With sheets("mas").Range("a2").Validation

حيث mas هو اسم الشيت الذي تريد وضع القائمة فيه

[الـعيدروس]

جزاك الله خير استاذ محمد صالح

حل جميل جدا

[ابو العلاء]

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

[الـعيدروس]

السلام عليكم

وهذا كود تم عمله مسبقاً شبيه كثير لكود استاذنا الحبيب محمد صالح

لاثراء الموضوع

هذا الكود في حدث ThisWorkbook

Private Sub Workbook_Open()

   For Each sh In ActiveWorkbook.Worksheets

   ALI_SH = ALI_SH & "," & sh.Name

   Next sh

   With ورقة1

   .Range("A1").Select

   With Selection.Validation

	   .Delete

	   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

	   xlBetween, Formula1:=ALI_SH

   End With

   End With

End Sub

وهذا في حدث الشيت

Private Sub Worksheet_Change(ByVal Target As Range)

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

	   Worksheets(Target.Value).Select

   End If

End Sub

[saad abed]

اخى محمد صالح

اخى ابونصار

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

حلول جميلة

وفقكم الله

[abouelhassan]

استاذنا ابونصار استاذنا محمد صالح

بارك الله لكما

من قلبى احترام

[الحسامي]

السلام عليكم

اذا تسمحوا لي ... هذه مساهمة مني للموضوع

Sub DropDown1_Change()

sh_list

Sheets(Sheets(1).Shapes("Drop1").ControlFormat.Value).Select

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

sh_list

End Sub

Sub sh_list()

Sheets(1).[a2:a100] = Empty

Dim Sh1 As Worksheet

For Each Sh1 In ActiveWorkbook.Sheets

Sheets(1).Range("a5000").End(xlUp).Offset(1, 0) = Sh1.Name

Next Sh1

End Sub

sheeet.rar

[saad abed]

اخى عماد الحسامى

مميز فى كل اعمالك

اسال الله لك التوفيق

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

سعد عابد

[الجزيرة]

أخي الحبيب / عماد

ما شاء الله لا قوة إلا بالله

[الـعيدروس]

السلام عليكم

استاذ عماد الحسامي حفظك الله ورعاك

اكوادك تدل على انسان متمكن

الاكسل مع الحسامي ( بلا حدود )

وفقك الله وسدد خطاك وحماك من كل مكروه

تقبل تحياتي وشكري

[spiritsolo]

السلام عليكم

انا اريد العكس بالظبط

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

اي 200 شيت .

هل توجد طريقة لهذا ؟ امم انه دري من الخيال ؟

[ابو اياد ( الاسيوطى )]

الاخوة الاعضاء ارجو زيارة موضوعى علة يفيد

 

http://www.officena.net/ib/index.php?showtopic=47650#entry288257

[الـعيدروس]

الاخ spiritsolo

انشاء موضوع جديد لطلبك

مع اضافة مثال كبيانات وهمية

وان شاء الله تجد حلول