ياسر العربى

البقاء لله اخي الكريم ناصر

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

تفضل مثال تم تنفيذه للكارينهات من قبل في هذا الموضوع 
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);"")

وممكن تغيرا لفراغ بوضع صفر عادي

اتمنى ان يكون هو  المطلوب
تحياتي

في 7/14/2017 at 22:52, وليد عفيفي said:

استاذنا العزيز

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

ارجو المساعدة فى شرح كيف تم ربط شيت اكسل ( محمى بكلمة مرور ) مع فجيول بيسك 6

وذلك كالمثال الذى تفضلت بعرضة ( مخازن بسيط ) . @ياسر العربى

اجبار الماكرو على العمل.rar

تم الرد في قسم الاكسيل 
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

 

أخى الكريم

اليكم الملف بالمرفقات بعد التعديل لعله المطلوب

تجد جدول فيه الإحصائيات المطلوبة 

جمع مع فلترة___1.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