عمل زر لفتح شيت اكسيل

[اسلام سيد]

انا عندى ملف اكسيل به حوالى 30 شيت وهو نسخة اوفس 2010 واريد عمل شيت بة زر لكل شيت باسماء الشيتات اى 30زر ل30شيت واريد معرفة طريقة الربط والاكواد بارك الله فيكم.

[محمود رواس]

الاخ اسلام المحترم

برجاء ارفاق الملف ليتم عمل المطلوب ، لارفاق الملف يجب ضغطه باحد برامج الضغط ثم ارفاقه .

وشكراً ،،،،

[الـعيدروس]

السلام عليكم

إنشاء ورقة جديدة في ملفك وإستخدم الكود التالي مرة واحده فقط

Public Sub Ali_AddB()

Dim S$, C, T, i, ii

T = 1

On Error Resume Next

For ii = 1 To ActiveSheet.Shapes.Count

If ActiveSheet.Shapes.Count > 0 Then

ActiveSheet.Shapes(ii).Delete

End If

Next

For i = 1 To Sheets.Count

If Sheets(i).Name = ActiveSheet.Name Then GoTo 1

With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule

C = .CountOfLines + 1

.InsertLines C, _

"Sub my_" & i & "()" & Chr(13) & _

" Sheets(" & i & ")" & ".Select" & Chr(13) & _

"End Sub"

End With

    ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select

    S = Selection.Name

    Selection.Caption = Sheets(i).Name

    Selection.OnAction = "my_" & i

    T = T + 24

1 Next

End Sub

[اسلام سيد]

وعليكم السلام ,أستاذ ابو نصار قمت بفتح شيت جديد فى الملف ونقرت عليه بيمين الماوس واخترت view code ووضعت فيه الكود ، ماذا بعد ذالك بارك الله فيك؟

[الـعيدروس]

ليس هكذا

اظغط زر Alt + F11

ثم اذهب الى قائمة Insert اختار Module

ثم الصق كود في Module

بعدها اذهب الى الورقة الجديدة وإضغط Alt + F8

اختار الكود المسمى Ali_AddB ثم تشغيل

تم تعديل يناير 2, 2013 بواسطه عباد

[اسلام سيد]

بارك الله فيك استاذنا الفاضل أبو نصار قمت بعمل الخطوة السابقة وظهر لى بالفعل مستطيلات بها اسم الشيتات كل شيت بزر على حدى ولكن عندما اضغط على الزر يظهر لى رسالة cannot run the macro فماذا افعل لتشغيله بارك الله فيك؟

[الـعيدروس]

ملفك هل يوجد فيه أكواد ؟؟

اذا به اكواد الصق الكود في Module1

وحذف جميع الأكواد المسماه "my_ 1 " و "my_ 2 " حتى اخر كود

[اسلام سيد]

تأكدت من عدم وجود اى اكواد اخرى ومع ذلك مازالت المشكله قائمة ،ولكن هل فى البدايه عندما اضغط على زر Alt + F11 اكون فى مكان معين ام اكون فى اى شيت فى الملف بخلاف الشيت الجديد ،وبارك الله فيك على تواصل حضرتك معى.

[الـعيدروس]

ادراج الكود يكون في مودويل ليس في حدث ورقة

كما شرحت لك سابقاً

أنا جرب الكود يمل بكفائه

إذا تقدر ترفق ملفك أطبق الكود عليه فلا بأس

منتظر ردك

[حمادة عمر]

السلام عليكم

الاستاذ / القدير عباد

الكود يعمل بكفاءة وروعة

تسلم ايدك استاذنا

والاخ الكريم صاحب الموضوع (( ارفاق ملف يسهل عليك وعلي خبراء المنتدي كثيرا )))

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

[اسلام سيد]

حاضر دقائق وسأرسله لكم ان شاء الله

[حمادة عمر]

السلام عليكم

لرفع ملفات للمنتدي يجب القيام بضغطها اولا والرابط التالي به الطريقة فيديو

http://www.officena....showtopic=44625

[اسلام سيد]

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

[الـعيدروس]

الظاهر ان حجم الملف كبير

إضغط الملف اول مره

ثم انشاء مجلد جديد وحط الملف المضغوط السابق فيه

ثم إضغط المجلد الجديد

وجرب إرفقه

[اسلام سيد]

السلام عليكم استاذنا الفاضل ابو نصار قمت بارفق الملف الذى تحدثت عنه فى البدايه لكنى قمت بتفريغ محتواه من بيانات تخص شركتنا لاهميتها فقط وقمت بحذف اكثر الشيتات التى لاتهم لان الملف كان ثقيل جدا مع ابقائى للمعادلات الهامه كما سترها، وحذف لما ذكرت من شيتات ليس لاخفائى علم تعلمته ،وبارك الله فيك ونفعنا بعلمك .

واليك الان الملف المذكور.

ملف مضغوط.rar

[الـعيدروس]

السلام عليكم

نفس الطريقة السابقه في إدراج كود

جرب هذا الكود

الأن شغل الكود عدة مرات طبيعي لايؤثر

لانه يقوم بحذف الأزرار السابقه وبرضه يحذف الأكواد المسماه "my_ 1 "

ماعليك سوى إدراجه في Module1 وتشغيله

Public Sub Ali_AddB()

Dim S$, C, T, i, ii

T = 1

On Error Resume Next

Dim Op As VBComponent

Dim Opj As VBComponent

For ii = 1 To ActiveSheet.Shapes.Count

If ActiveSheet.Shapes.Count > 0 Then

ActiveSheet.Shapes(ii).Delete

End If

Next

Set Op = ActiveWorkbook.VBProject.VBComponents("A_Mod")

ActiveWorkbook.VBProject.VBComponents.Remove Op

Set Opj = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)

Opj.Name = "A_Mod"

For i = 1 To Sheets.Count

If Sheets(i).Name = ActiveSheet.Name Then GoTo 1

With Opj.CodeModule

C = .CountOfLines + 1

.InsertLines C, _

"Sub my_" & i & "()" & Chr(13) & _

" Sheets(" & i & ")" & ".Select" & Chr(13) & _

"End Sub"

End With

	 ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select

	 S = Selection.Name

	 Selection.Caption = Sheets(i).Name

	 Selection.OnAction = "my_" & i

	 T = T + 24

1 Next

End Sub

[اسلام سيد]

السلام عليكم استاذنا عباد ( ابو نصار)،

(قد بلغت منى عذرا)

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

واخيرا وليس اخرا لا يسعنى إلا انا ادعوا الله لكم بمزيد من الصحه والعافيه والعلم النافع.

وإليكم الملف وبه الكود الاول:

111111111111111111111111.rar

[حمادة عمر]

السلام عليكم

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

فعلا قد جربت الكود ولا يعمل لدي ايضا ويعطي خطأ ما في الكود في هذين السطرين

Dim Op As VBComponent

Dim Opj As VBComponent

حاولت تعديله ولكن كان يعمل ويضيف الازرار لكن دون ربطها بالصفحات

جزاك الله خيرا استاذنا

[ahmd_asd4]

الملف المرفق بإكسل 2010 أو 2007 وكنت أريد أن أحقق المطلوب عن طريق الهبير لينك

أسر من الكود و أضمن

[الـعيدروس]

السلام عليكم

عذرا لم انتبه ان الكود يحدث خطاء

جرب هكذا

شغل الكود المسمى Ali_Ad_Ref

Public Sub Ali_Ad_Ref()

On Error Resume Next

ActiveWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0

'*************************

Call Ali_AddB

'*************************

End Sub

Private Sub Ali_AddB()

Dim S$, C, T, i, ii

Dim Sh As Shape

Dim Op As VBComponent

Dim Opj As VBComponent

T = 1

On Error Resume Next

For Each Sh In ActiveSheet.Shapes

  If ActiveSheet.Shapes.count > 0 Then

    Sh.Delete

  End If

Next

If IsError(Op) = False Then Else GoTo 0

  Set Op = ActiveWorkbook.VBProject.VBComponents("A_Mod")

   ActiveWorkbook.VBProject.VBComponents.Remove Op

0:

   Set Opj = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)

Opj.Name = "A_Mod"

For i = 1 To Sheets.count

   If Sheets(i).Name = ActiveSheet.Name Then GoTo 1

With Opj.CodeModule

   C = .CountOfLines + 1

	 .InsertLines C, "Sub my_" & i & "()" & Chr(13) & _

   " Sheets(" & i & ")" & ".Select" & Chr(13) & "End Sub"

End With

    ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select

    S = Selection.Name

	  Selection.Caption = Sheets(i).Name

	   Selection.OnAction = "my_" & i

	 T = T + 24

1 Next

End Sub

[اسلام سيد]

وعليكم السلام

استاذنا ابو نصار وبارك الله فيك على محاولتك مساعدتى رغم مسؤلياتك الكبيرة ، لكن ايضا الكود لايقتح ولا يعطى اساسا مستطيل الزر كالكود الاول ، ورجاءا استاذنا القدير لو عند حضرتك اى ملف يعمل بالكود ارسله لى لكى ابحث فيه سبب المشكله ، ولك منى جزيل الشكر والتقدير.

[الـعيدروس]

السلام عليكم

إضغط على الزر المسمى تشغيل في ورقة الزر

A_Sh1.rar

[اسلام سيد]

وعليكم السلام استاذنا ابو نصار قمت بالضغط على زر تشغيل فى شيت الزر إلا أنه اظهر الاالمستطيلات (الزراير) وأعطانى رساله بعدم الفتح

فماذا افعل ؟

تم تعديل يناير 3, 2013 بواسطه eslamsayed

[حمادة عمر]

السلام عليكم

وعليكم السلام استاذنا ابو نصار قمت بالضغط على زر تشغيل فى شيت الزر إلا أنه اظهر الاالمستطيلات (الزراير) وأعطانى رساله بعدم الفتح

فماذا افعل ؟

وهذا ما حدث معي بالضبط ... ايضا استاذنا / ابو نصار

[الـعيدروس]

انا جربت الملف على أوفيس 2003 و 2007

ويعمل بشكل ممتاز

الأخوه الاحبه

بعد تشغيل الكود

ارجو الذهاب الى محرر الاكواد ثم قائمة Tools ثم References

والتأكد من الجمله التاليه إن كان المربع المقابل لها محفز ام لا

Microsoft Visual Basic for Applications Extensibility 5.3