ياسر العربى

البقاء لله اخي الكريم ناصر اللهم ارحمه واغفر له واجعل قبره روضه من رياض الجنه

تفضل مثال تم تنفيذه للكارينهات من قبل في هذا الموضوع https://www.officena.net/ib/topic/70163-تصميم-برنامج-لبطاقات-دخول-الموظفين/ تحياتي

وأرى انك لا تريد العمل على الشيتات وكأنك تريده برنامج تنفيذي تفضل البرنامج تنفيذي تحياتي Project1.rar

تفضل اخي الكريم لعله المطلوب لم اجرب كل القيم يرجى التأكد من النتائج تحياتي Offecena.rar

واضح من معناها اذهب الى 86 والرقم ما هو الا رقم يمكن استبداله باي رقم اخر او كلمة تستطيع التجربة بنفسك كل ما في الامر هو تخطى الترحيل والذهاب الى الخطوة التالية داخل الحلقة التكرارية اذا تحقق الشرط وهو ايجاد التكرار فيقوم باضافة عدد واحد كل مرة للمتغير اكس حتى نهاية الكود ويتم عرضهم في اخر الكود اما بخصوص Goto بعد تحقق الشرط ووجود التكرار يقوم بالذهاب الى النقطة المحددة كما بالصورة وهي next الخاصة بالحقلة التكرارية للترحيل فيقوم بتخطى الترحيل والذهاب الى التالي حتى انتهاء الحلقة التكرارية اتمنى ان اكون قد اوضحت المطلوب تحياتي

تفضل التعديل يعطى رسالة في نهاية الترحيل بعدد المكرر ان لم يجد تكرار يعطى تم الترحيل بدون تكرار تحياتي اصنافform - Copy.rar

تفضل الحل لعله المطلوب وياريت تبقي تخلي بالك ان الملف محمي بكلمة مرور تحياتي اصنافform - Copy.rar

حبيبي ابوالبراء ياغالي نعمل ايه بقي الركنة وحشة والمخ بدأ يصدى ودا مينفعش يتركن لازم يفضل شغال وحشنا ياغالي تقبل فائق احترامي

تفضل المرفق به الحل للموضوع السابق والحالي تحياتي Book1.rar

لابد من تغيير تنسيق الخلايا الى رقم اوعام او استخدم الدالة TEXT للتنسيق كيفما تشاء مثلا هكذا =TEXT(IFERROR(HOUR(F4-$E$2)*60+MINUTE(F4-$E$2);"");"0") تحياتي

لحساب فرق الدقائق تكتب المعادلة هكذا =MINUTE(F4-$E$2) لحساب فرق الساعات تكتب هكذا =HOUR(F4-$E$2) لو محتاج اجمالي الدقائق بس ممكن تكتب المعادلة كدا =HOUR(F4-$E$2)*60+MINUTE(F4-$E$2) وعشان ميظهرش خطأ عندما تكون الخلية فارغة او فيها نص نكتبها كدا =IFERROR(HOUR(F4-$E$2)*60+MINUTE(F4-$E$2);"") وممكن تغيرا لفراغ بوضع صفر عادي اتمنى ان يكون هو المطلوب تحياتي

تم الرد في قسم الاكسيل https://www.officena.net/ib/topic/78392-كيف-يتم-ربط-شيت-اكسيل-محمي-بفيجول-بيسك-6/ تحياتي

تفضل اخي الكريم وليد عفيفي الرابط لسلسلة فيجوال بيسك 6 وفي اخر السلسلة طريقة الربط https://www.officena.net/ib/topic/65629-سلسلة-دروس-الفيجوال-بيسك-6-والاكسيل-من-علي-مصطبة-ياسر-العربي/ ومرفق مثال بالسورس كود للفيجوال6 تحياتي Code vb6 & Excel.rar

وطول عمرى كسول :) وحتى كسلت اعلن عن المتغيرات المهم اللي يعدل علينا حبايبنا تسلملي حبيبي تحياتي لك

تفضل هذا الموضوع http://yasserelaraby86.blogspot.com.eg/2016/10/split-text-number.html تحياتي

جرب المرفق لعله المطلوب تحياتي pc.rar

الاخ والاستاذ الكريم محمود الشريف تحياتي لكم وكيف اخباركم هذه المشاركة فقط لايصال سلام الاخ العزيز حسام عيسى الصقر لكم تحياتي لكم

الموضوع بسيط بالدالة SUBTOTAL تفضل اما بخصوص ظهور الصفر من عدمه لم افهم طلبك هل تحتاج الصفر ام لا ؟ جمع مع فلترة.rar

اتفضل التكه ويبقى كدا رضا Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x For sh = LBound(arr) To UBound(arr) Sheets(arr(sh)).Range("A9:V" & Sheets(arr(sh)).Cells(Rows.Count, 1).End(xlUp).Row).ClearContents Next End If MsgBox "Done....(-_-)..." End Sub تحياتي

تفضل حبيبي Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x End If MsgBox "Done....(-_-)..." End Sub تحياتي

تفضل بيان بمعلمى المدرسة وتخصصاتهم.rar

بعد اذن الاخوة الكرام تفضل اخي تعديل بسيط لتطبيق على الشيتات دفعه واحده Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next MsgBox "Done....(-_-)..." End Sub الشيتات المراد التعديل عليها داخل مصفوفة تستطيع تحديد اي شيتات تريد تحياتي

تفضل تنبيه في حالة ادخال ارقام اقل واكبر.rar

تفضل لعله المطلوب عدم تكرار.rar