اضافة زر يمكننى من التنقل بين الشيتات

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

زر للتنقل.rar

[أبو أنس حاجب]

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

أخي الفاضل حفظكم الله

أهدي لك هذا الملف وهو عبارة عن عدة ملفات في ملف واحد تحتوي على تشكيلة عريضة نسبياً على حد أستطاعتي من المعادلات والأكواد قمت بتجميعها في ملف واحد أرجو أن ينتفع به ومنها الكود الذي طلبته وهو في أول صفحة سوف يفتح فيها الملف.

تقبل فائق الأحترام

أبو أنس ناصر حاجب

ٍٍSupporter2.rar

[عبدالله باقشير]

السلام عليكم

الشكر واصل للاخ ابو انس حفظه الله

كود التنقل يكفي سطر واحد

' كود التنقل بين الاوراق

Sub ShowSheetLists()

Application.CommandBars("Workbook tabs").ShowPopup

End Sub

وطلب صاحب الموضوع

في المرفق ادناه

-------------------------------------

فكرة الكود :

ان زر التنقل موجود في الورقة الرئيسية

والكود اثناء اضافة الورقة الجديدة

ينسخ الزر ويلصقه في هذه الورقة

-------------------------------------

المرفق 2003-2007

زر للتنقل.rar

[ريان أحمد]

السلام عليكم

هل تنجح هذه الطريقة في الجداول المحورية

[يوسف عطا]

السلام عليكم

الشكر واصل للاخ ابو انس حفظه الله

كود التنقل يكفي سطر واحد

' كود التنقل بين الاوراق

Sub ShowSheetLists()

Application.CommandBars("Workbook tabs").ShowPopup

End Sub

وطلب صاحب الموضوع

في المرفق ادناه

-------------------------------------

فكرة الكود :

ان زر التنقل موجود في الورقة الرئيسية

والكود اثناء اضافة الورقة الجديدة

ينسخ الزر ويلصقه في هذه الورقة

-------------------------------------

المرفق 2003-2007

زر للتنقل.rar

أخونا المتألق والمبدع دائماً خبور خير الغالى

تحية وتقدير لسيادتكم

لى طلب فى الكود الخاص بالتنقل بين شيتات الملف

لدى ملف به 31 شيت و جميع الشيتات مسماه بأرقام فقط من 1 إلى 31

أريد أن يتم كتابة إسم لكل شيت بالكود لكى يظهر باللستة إسم الشيت وليس رقمه المسمى به

مثلاً شيت رقم 22 يظل إسمه كما هو ( 22 ) ولكن إسمه يظهر بليست التنقل بين الشيتات بالإسم الذى أريده مثلاً ( ناجح دور ثان)

هل هذا يمكن ؟؟

[الخالدي]

لدى ملف به 31 شيت و جميع الشيتات مسماه بأرقام فقط من 1 إلى 31

أريد أن يتم كتابة إسم لكل شيت بالكود لكى يظهر باللستة إسم الشيت وليس رقمه المسمى به

مثلاً شيت رقم 22 يظل إسمه كما هو ( 22 ) ولكن إسمه يظهر بليست التنقل بين الشيتات بالإسم الذى أريده مثلاً ( ناجح دور ثان)

هل هذا يمكن ؟؟

جرب الكود المرفق

ارجوا ان يفي بالغرض

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

مثال.rar

[الـعيدروس]

السلام عليكم

تعديل بسيط على كود الاستاذ الحبيب الخالدي

بعد اذنه

Sub MENU_SheetLists()

Dim CB_L As Object

Dim CB_C As CommandBarControl

On Error GoTo Error1:

Application.CommandBars("MySheetList").Delete

Error1:

Set CB_L = CommandBars.Add(Name:="MySheetList", Position:=msoBarPopup)

For Each Sh In ThisWorkbook.Worksheets

    Set CB_C = Application.CommandBars("MySheetList").Controls.Add(Type:=msoControlButton)

    With CB_C

		 .Caption = Sh.CodeName: .OnAction = "GO_MySheet"

    End With

Next

Set CB_L = Nothing: Set CB_C = Nothing

Application.CommandBars("MySheetList").ShowPopup

End Sub

Sub GO_MySheet()

Sheets(Application.CommandBars.ActionControl.Index).Activate

End Sub

تم تعديل أكتوبر 21, 2012 بواسطه عباد

[عبدالله باقشير]

السلام عليكم

فكرة رائعة اخي الحبيب الخالدي--------حفظكم الله

وتطوير ذكي اخي عباد -------------حفظكم الله

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

[الـعيدروس]

استاذنا العبقري خبور خير

كلماتك وسام من ذهب واعتز بها

وفقك الله وسدد خطاك

كود جميل من الاستاذ الخالدي

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

[يوسف عطا]

أساتذتنا الأفاضل

الكود لا زال يقوم بعرض اسماء الشيتات كما هى باسمائها فى علامة تبويب كل ورقة

المطلوب أن يكون فى الكود سطر لكل شيت بحيث تظهر عند الضغط على الزر اسماء الشيتات كما أكتبها بالكود وليس كما هى اسمائها بعلامات التبويب

مثلاً الشيت 1 أكتب له فى الكود إسم آخر يظهر به عند الضغط على زر الأوراق

أرجو الفكرة وصلت

لكم تحياتى

[الـعيدروس]

الاخ الفاضل يوسف عطا

مسمى الورقة ( Name و CodeName )

شاهد المرفق

Sh_Ca.rar

[عبدالله باقشير]

أساتذتنا الأفاضل

الكود لا زال يقوم بعرض اسماء الشيتات كما هى باسمائها فى علامة تبويب كل ورقة

المطلوب أن يكون فى الكود سطر لكل شيت بحيث تظهر عند الضغط على الزر اسماء الشيتات كما أكتبها بالكود وليس كما هى اسمائها بعلامات التبويب

مثلاً الشيت 1 أكتب له فى الكود إسم آخر يظهر به عند الضغط على زر الأوراق

أرجو الفكرة وصلت

لكم تحياتى

اخي يوسف هل هذا ما قصدته

Option Explicit


Const mBr As String = "MySheetList"


Sub kh_AddName()

Dim Nam As Range

Dim i As Integer

Dim NamSheet As String

'''''''''''''''''''''''''''''''

On Error GoTo kh_Err

'''''''''''''''''''''''''''''''

kh_BarDelete

'''''''''''''''''''''''''''''''

Set Nam = ورقة1.Range("C3:D22")

'''''''''''''''''''''''''''''''

With Application.CommandBars.Add(Name:=mBr, Position:=msoBarPopup)

For i = 1 To Nam.Rows.Count

NamSheet = Nam.Cells(i, "A")

With .Controls.Add(Type:=msoControlButton)

.Caption = Nam.Cells(i, "B")

.OnAction = "GO_MySheet"

.Tag = NamSheet

If NamSheet = ActiveSheet.Name Then .State = -1

If IsError(Evaluate("'" & NamSheet & "'!A1")) Then

.Enabled = False

End If

End With

Next

End With

'''''''''''''''''''''''''''''''

Application.CommandBars(mBr).ShowPopup

'''''''''''''''''''''''''''''''

kh_Err:

Set Nam = Nothing

If Err Then MsgBox "Err.Number : " & Err.Number

kh_BarDelete


End Sub


Sub kh_BarDelete()

On Error Resume Next

Application.CommandBars(mBr).Delete

On Error GoTo 0

End Sub


Sub GO_MySheet()

Dim N As String

N = Application.CommandBars.ActionControl.Tag

Sheets(N).Activate

End Sub

المرفق 2003-2007

مثال اضافة اسم مخصص لاوراق العمل في بار مخصص.rar

[الـعيدروس]

السلام عليكم

جزاك الله خير استاذ عبدالله

[يوسف عطا]

الله ينور عباد باشا

بس لو ممكن ولو مافيهاش تعب لمعاليكم ولكل من يريد إثراء الموضوع

اسماء كل الشيتات التى أريد إظهارها بالكود موجودة فى أحد شيتات الملف ( الشيت رقم 31 والمسمى MyDate والذى أريده أن يظهر بالكود بإسم الصلاحيات ) بالصف الثانى من العمود الخامس E2 إلى العمود 35 AI2

هل يمكن أن يأخذ الكود اسماء الشيتات من هذا الشيت ؟؟ علماً بأنه الشيت الوحيد بين الشيتات الذى مسماه ليس رقم

والصورة المرفقة توضح أسماء الشيتات بالأرقام ومدلول الأرقام بالأسماء

Uploaded with ImageShack.us

[يوسف عطا]

الله ينور عليك يا عالمنا الكبير خبور خير

ولكن أسماء الشيتات وأرقامها ليست بالطول ولكنها بالعرض كما أرفقت الصورة بالمشاركة السابقة

جارى محاولة تعديل الكود وسأوافيك بالنتيجة

الف شكر

[الـعيدروس]

السلام عليكم

بعد اذن استاذنا القدير خبور خير

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

Option Explicit

Const mBr As String = "MySheetList"

Sub kh_AddName()

Dim Nam As Range

Dim i As Integer

Dim NamSheet As String

'''''''''''''''''''''''''''''''

On Error GoTo kh_Err

'''''''''''''''''''''''''''''''

kh_BarDelete

'''''''''''''''''''''''''''''''

Set Nam = ورقة1.Range("E2:AH3")

'''''''''''''''''''''''''''''''

With Application.CommandBars.Add(Name:=mBr, Position:=msoBarPopup)

    For i = 1 To Nam.Columns.Count

	    NamSheet = Nam.Cells(2, i)

	    With .Controls.Add(Type:=msoControlButton)

		    .Caption = Nam.Cells(1, i)

		    .OnAction = "GO_MySheet"

		    .Tag = NamSheet

		    If NamSheet = ActiveSheet.Name Then .State = -1

		    If IsError(Evaluate("'" & NamSheet & "'!A1")) Then

			    .Enabled = False

		    End If

	    End With

    Next

End With

'''''''''''''''''''''''''''''''

Application.CommandBars(mBr).ShowPopup

'''''''''''''''''''''''''''''''

kh_Err:

Set Nam = Nothing

If Err Then MsgBox "Err.Number : " & Err.Number

kh_BarDelete

End Sub

Sub kh_BarDelete()

On Error Resume Next

Application.CommandBars(mBr).Delete

On Error GoTo 0

End Sub

Sub GO_MySheet()

Dim N As String

N = Application.CommandBars.ActionControl.Tag

Sheets(N).Activate

End Sub

[يوسف عطا]

مشكور أبو نصار

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

وكل عام وسيادتكم بخير

والشكر موصول لأستاذنا الكبير خبور خير جازاه الله خيراً

[يوسف عطا]

أخوتى الأعزاء

ذادكم الله من العلم

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

N = Application.CommandBars.ActionControl.Tag

[الـعيدروس]

السلام عليكم

الله يبارك فيك اخي يوسف

اعاده الله علينا وعليكم وعلى الامه الاسلاميه باليمن والبركه

استبدل السطر بهذا

N = Application.CommandBars.ActionControl.Index

[يوسف عطا]

مشكور ابو نصار

جارى التجربة

[يوسف عطا]

الغالى أبو نصار

للاسف إستمرت المشكلة

الإرور لا زال موجود وتم تلوين السطر الذى تم تعديله باللون الأصفر ايضاً

[يوسف عطا]

للرفع رفع الله قدركم

[الـعيدروس]

السلام عليكم

جرب التعديل التالي

مع اضافة سطر تجاهل رسائل الخطاء

Sub GO_MySheet()

Dim N

On Error Resume Next

N = Application.CommandBars.ActionControl.Index

Sheets(N).Activate

End Sub

[يوسف عطا]

جارى التجربة أخى الغالى والملف مفتوح أمامى بالفعل

هل أضع الاسطر السابقة مكان السطر الذى يعطينى إرور ؟

أم ماذا ؟

[يوسف عطا]

لم يظبط معى ايضاً أخى الغالى

مرفق الملف والمفروض أن زر التنقل بين الصفحات فى الورقة رقم 2 فى العمود H

والكود موجود فى موديول رقم 11

وأسماء الشيتات يمكن الوصول إليها من شيت رقم 32 أو من شيت ماى ديت

وفى حالة غستخدام شيت رقم 32 يمكن إستخدام الجدول الطولى أو الجدول العرضى حسب ما يحلو لكم

اليوزر يوسف

الباس 111

تم الضغط مرتين لأن حجم الملف كان كبير

الف شكر

مجلد جديد.rar