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

**اسلام سيد** · يناير 2, 2013

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

محمود رواس · يناير 2, 2013

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

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

وشكراً ،،،،

**الـعيدروس** · يناير 2, 2013

السلام عليكم

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


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

**اسلام سيد** · يناير 2, 2013

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

**الـعيدروس** · يناير 2, 2013

ليس هكذا

اظغط زر Alt + F11

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

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

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

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

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

**اسلام سيد** · يناير 2, 2013

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

**الـعيدروس** · يناير 2, 2013

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

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

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

**اسلام سيد** · يناير 2, 2013

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

**الـعيدروس** · يناير 2, 2013

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

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

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

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

منتظر ردك

**حمادة عمر** · يناير 2, 2013

السلام عليكم

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

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

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

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

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

**اسلام سيد** · يناير 2, 2013

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

**حمادة عمر** · يناير 2, 2013

السلام عليكم

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

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

**اسلام سيد** · يناير 2, 2013

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

**الـعيدروس** · يناير 2, 2013

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

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

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

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

وجرب إرفقه

**اسلام سيد** · يناير 2, 2013

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

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

ملف مضغوط.rar

**الـعيدروس** · يناير 2, 2013

السلام عليكم

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

جرب هذا الكود

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

لانه يقوم بحذف الأزرار السابقه وبرضه يحذف الأكواد المسماه "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

**اسلام سيد** · يناير 2, 2013

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

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

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

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

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

111111111111111111111111.rar

**حمادة عمر** · يناير 2, 2013

السلام عليكم

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

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


Dim Op As VBComponent

Dim Opj As VBComponent

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

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

ahmd_asd4 · يناير 2, 2013

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

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

**الـعيدروس** · يناير 3, 2013

السلام عليكم

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

جرب هكذا

شغل الكود المسمى 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

**اسلام سيد** · يناير 3, 2013

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

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

**الـعيدروس** · يناير 3, 2013

السلام عليكم

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

A_Sh1.rar

**اسلام سيد** · يناير 3, 2013

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

فماذا افعل ؟

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

**حمادة عمر** · يناير 3, 2013

السلام عليكم

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

فماذا افعل ؟

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

**الـعيدروس** · يناير 3, 2013

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

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

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

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

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

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


Microsoft Visual Basic for Applications Extensibility 5.3

تسجيل الدخول

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

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

اسلام سيد

محمود رواس

الـعيدروس

اسلام سيد

الـعيدروس

اسلام سيد

الـعيدروس

اسلام سيد

الـعيدروس

حمادة عمر

اسلام سيد

حمادة عمر

اسلام سيد

الـعيدروس

اسلام سيد

الـعيدروس

اسلام سيد

حمادة عمر

ahmd_asd4

الـعيدروس

اسلام سيد

الـعيدروس

اسلام سيد

حمادة عمر

الـعيدروس

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information