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

**إبراهيم ابوليله** · أكتوبر 18, 2012

**أبو أنس حاجب** · أكتوبر 18, 2012

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

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

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

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

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

ٍٍSupporter2.rar

**عبدالله باقشير** · أكتوبر 18, 2012

السلام عليكم

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

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


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

Sub ShowSheetLists()

Application.CommandBars("Workbook tabs").ShowPopup

End Sub

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

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

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

فكرة الكود :

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

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

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

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

المرفق 2003-2007

زر للتنقل.rar

**ريان أحمد** · أكتوبر 18, 2012

السلام عليكم

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

**يوسف عطا** · أكتوبر 20, 2012

السلام عليكم

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

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

Sub ShowSheetLists()

Application.CommandBars("Workbook tabs").ShowPopup

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

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

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

فكرة الكود :

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

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

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

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

المرفق 2003-2007

زر للتنقل.rar

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

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

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

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

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

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

هل هذا يمكن ؟؟

**الخالدي** · أكتوبر 21, 2012

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

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

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

هل هذا يمكن ؟؟

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

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

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

مثال.rar

**الـعيدروس** · أكتوبر 21, 2012

السلام عليكم

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

بعد اذنه


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 بواسطه عباد

**عبدالله باقشير** · أكتوبر 21, 2012

السلام عليكم

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

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

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

**الـعيدروس** · أكتوبر 21, 2012

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

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

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

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

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

**يوسف عطا** · أكتوبر 23, 2012

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

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

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

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

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

لكم تحياتى

**الـعيدروس** · أكتوبر 23, 2012

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

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

شاهد المرفق

Sh_Ca.rar

**عبدالله باقشير** · أكتوبر 23, 2012

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

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

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

مثلاً الشيت 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

**الـعيدروس** · أكتوبر 23, 2012

السلام عليكم

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

**يوسف عطا** · أكتوبر 23, 2012

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

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

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

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

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

Uploaded with ImageShack.us

**يوسف عطا** · أكتوبر 23, 2012

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

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

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

الف شكر

**الـعيدروس** · أكتوبر 23, 2012

السلام عليكم

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

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


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

**يوسف عطا** · أكتوبر 24, 2012

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

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

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

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

**يوسف عطا** · أكتوبر 24, 2012

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

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

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


N = Application.CommandBars.ActionControl.Tag

**الـعيدروس** · أكتوبر 24, 2012

السلام عليكم

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

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

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


N = Application.CommandBars.ActionControl.Index

**يوسف عطا** · أكتوبر 27, 2012

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

جارى التجربة

**يوسف عطا** · أكتوبر 27, 2012

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

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

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

**يوسف عطا** · أكتوبر 31, 2012

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

**الـعيدروس** · نوفمبر 1, 2012

السلام عليكم

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

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


Sub GO_MySheet()

Dim N

On Error Resume Next

N = Application.CommandBars.ActionControl.Index

Sheets(N).Activate

End Sub

**يوسف عطا** · نوفمبر 1, 2012

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

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

أم ماذا ؟

**يوسف عطا** · نوفمبر 1, 2012

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

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

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

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

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

اليوزر يوسف

الباس 111

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

الف شكر

مجلد جديد.rar

تسجيل الدخول

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

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

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

انشئ حساب جديد

تسجيل دخول

محتوي مشابه

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information