اذهب الي المحتوي
أوفيسنا

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

قام بنشر

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

قبل كل شيء يجزيكم الله كل خير وبعد :

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

اريد ان يتم في صفحه اخرى مايلي

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

قام بنشر

هذا ملف اهداه لي الاستاذ ياسر خليل ولكني اريد فيه التغيير المطلوب جزاكم الله خيرا

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

Expiry Dates Using Conditional Formatting YasserKhalil.rar

قام بنشر
 

استاذ سليم

يحفظك ربنا ويصونك

سامحني اشرحها لي ومافائده الجدول الصغير الموجود بالصفحه المصدر

وماذا افعل عند عمل ملف جديد ؟

 هذا الجدول لم اضعه انا اذا لم تكن بحاجة اليه يمكن ازالته

عندما تريد ان تفتح ملفاً جديداً احقظ هذا الملف بواسطة الضغط على F12 ثم اعطه اسماً يناسبك

بذلك تخلق ملفاً جديداً غير الاصيل بنفس المعادلات و نفس التنسيق 

قام بنشر
 

وماذا افعل عند عمل ملف جديد ؟

اين توجد المعادلات المحميه ؟

المعادلات في صفحة Salim كلها محمية (من التغيير فقط وليس الحذف)

جرب ان تغير شيئاً في اي معادلة و لاحظ النتيجة

قام بنشر

مامعنى =CHAR(156)

واذا اردنا حمايه المعادلات من الحذف ايضا ... ربنا يحفظك

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

قام بنشر

حتى يكون الموضوع شاملا لكل

من يبحث عن الاشعار بقرب انتهاء العقود

هذا ملف جزى الله صانعه كل خير وبارك له ولكنه ياتي بالتنبيه بعد التاريخ وليس قبله

المطلوب : من المحترمين تغيير بحيث ياتي بالتنبيه قبل تاريخ الانتهاء

 

تنبيـــــهات.rar

قام بنشر

=============================================

Sub ExpiredDate()
Dim LastRow As Integer
Dim LastRow2 As Integer
Dim Datecounter As Integer
Dim SnNo As Integer
Dim Mtype As String
Dim Cname As String
Dim Idate As Date
Dim PhNo As String
Dim Adrs As String
Dim Nvisit As Date

expd = Worksheets("Main").Range("A1")
MyDate = Date
Datecounter = 0
i = 0
Worksheets("Notifications").Range("A2:G1001").ClearContents
Worksheets("Main").Counterlbl.Caption = 0

    LastRow = Worksheets("Machines_card").Range("A2").End(xlDown).Row
    For irow = 2 To LastRow
'find data....................
        With Worksheets("Machines_card")
           If (.Cells(irow, 7) - MyDate) <= expd And (.Cells(irow, 7) - MyDate) > -1 Then
              
                SnNo = .Cells(irow, 1)
                Mtype = .Cells(irow, 2)
                Cname = .Cells(irow, 3)
                Idate = .Cells(irow, 4)
                PhNo = .Cells(irow, 5)
                Adrs = .Cells(irow, 6)
                Nvisit = .Cells(irow, 7)
                i = i + 1
                Datecounter = Datecounter + 1
                Worksheets("Main").Counterlbl.Caption = Datecounter
                
'Moving data.................
                      With Worksheets("Notifications")
                      LastRow2 = Worksheets("Notifications").Cells(.Rows.Count, "A").End(xlUp).Row
                              .Cells(LastRow2 + 1, 1) = SnNo
                              .Cells(LastRow2 + 1, 2) = Mtype
                              .Cells(LastRow2 + 1, 3) = Cname
                              .Cells(LastRow2 + 1, 4) = Idate
                              .Cells(LastRow2 + 1, 5) = PhNo
                              .Cells(LastRow2 + 1, 6) = Adrs
                              .Cells(LastRow2 + 1, 7) = Nvisit
                       End With
           End If
        End With
    Next irow
End Sub

هذا هو الكود المطلوب التعديل فيه .. جزاكم الله خيرا

قام بنشر
Sub Show()
'هذه الأكواد الثلاثة التالية تعمل على تسريع تنفيذ الأوامر
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

اكواد للتسريع وجدتها فوضعتها لعلها تفيد احد.. توضع في اول الكود واخره

قام بنشر

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

تاريخ الاستحقاق متساوي مع تاريخ اليوم يتلون اوتوماتيكي  باللون ازرق

ولو تاريخ الاستحقاق اقل من تاريخ اليوم بعدد الايام التي تكتبها يتلون باللون الاصفر

ولو تاريخ الاستحقاق فات ميعاده يتلون اوتوماتيكي باللون الاحمر

تنســـيق.rar

قام بنشر
في ١٣‏/٥‏/١٤٣٨ هـ at 10:34, ناصر سعيد said:

=============================================


Sub ExpiredDate()
Dim LastRow As Integer
Dim LastRow2 As Integer
Dim Datecounter As Integer
Dim SnNo As Integer
Dim Mtype As String
Dim Cname As String
Dim Idate As Date
Dim PhNo As String
Dim Adrs As String
Dim Nvisit As Date

expd = Worksheets("Main").Range("A1")
MyDate = Date
Datecounter = 0
i = 0
Worksheets("Notifications").Range("A2:G1001").ClearContents
Worksheets("Main").Counterlbl.Caption = 0

    LastRow = Worksheets("Machines_card").Range("A2").End(xlDown).Row
    For irow = 2 To LastRow
'find data....................
        With Worksheets("Machines_card")
           If (.Cells(irow, 7) - MyDate) <= expd And (.Cells(irow, 7) - MyDate) > -1 Then
              
                SnNo = .Cells(irow, 1)
                Mtype = .Cells(irow, 2)
                Cname = .Cells(irow, 3)
                Idate = .Cells(irow, 4)
                PhNo = .Cells(irow, 5)
                Adrs = .Cells(irow, 6)
                Nvisit = .Cells(irow, 7)
                i = i + 1
                Datecounter = Datecounter + 1
                Worksheets("Main").Counterlbl.Caption = Datecounter
                
'Moving data.................
                      With Worksheets("Notifications")
                      LastRow2 = Worksheets("Notifications").Cells(.Rows.Count, "A").End(xlUp).Row
                              .Cells(LastRow2 + 1, 1) = SnNo
                              .Cells(LastRow2 + 1, 2) = Mtype
                              .Cells(LastRow2 + 1, 3) = Cname
                              .Cells(LastRow2 + 1, 4) = Idate
                              .Cells(LastRow2 + 1, 5) = PhNo
                              .Cells(LastRow2 + 1, 6) = Adrs
                              .Cells(LastRow2 + 1, 7) = Nvisit
                       End With
           End If
        End With
    Next irow
End Sub

هذا هو الكود المطلوب التعديل فيه .. جزاكم الله خيرا

هذا هو الكود المطلوب التعديل فيه .. جزاكم الله خيرا

قام بنشر

السلام عليكم

حقيقة لم افهم المطلوب تماما -- عموما الجزء الخاص من الكود والخاص بتحديد موعد التنبيه هو 

   If (.Cells(irow, 7) - MyDate) <= expd And (.Cells(irow, 7) - MyDate) > -1 Then

وفقا لما فهمت من الطلب استبدله بــ

If (.Cells(irow, 7) - MyDate) >= expd Then

وان لم يكن كذلك ارجو مزيد من التوضيح مع بعض النتائج المتوقعة 

تقبلوا تحياتي 

  • Like 1
قام بنشر

الحمد لله الذي رزقنا باحد الرجال المحترمين وهو الاستاذ خالد الرشيدي

==

في صعحه Machines_Card  في الخليه H2  ضغ تاريخ اليوم .. حتى يتم المقاربه

امام الاسم الاول ( اسلام ) في تاريخ الانتهاء اكتب 18/2/2017

كده هذا الاسم وهذا التاريخ اكبر من تاريخ اليوم ب4 ايام

في صفحه Main  غي الخليه A1  اكنب العدد 4

ستلاحظ في صغحه Notifications  وجود الاسم اسلام بالرغم من انه ليس فيل الميعاد لان الميعاد هو ناريخ اليوم

المطلوب لو تاريخه قبل الميعاد يغني 10/2/2017 كان المقروض يظهر

 

قام بنشر (معدل)

السلام عليكم

زكرت حضرتك ان إسلام وجب ان يظهر لانه اقل من تاريخ اليوم ب 4 ايام وهو الرقم المدخل -- هناك عقود في تواريخ اقل من تاريخ اليوم ايضا ب 3 ايام او اقل او اكثر غير اسلام لم تذكر حضرتك هل كان من المفترض ادراجها ام لا ؟؟

عموما اليك التعديل التالي عله المطلوب -- لن يظهر سوي التاريخ الاقل من تاريخ اليوم ب  -- العدد المدخل -- ايام

 

If (MyDate - .Cells(irow, 7)) = expd And (MyDate - .Cells(irow, 7)) > -1 Then

تنبيـــــهات_3.rar

تقبل تحياتي وشكري علي هذه الكلمات الرائعه من حضرتك -- شكرا جزيلا

تم تعديل بواسطه خالد الرشيدى
  • Like 2
قام بنشر
59 دقائق مضت, خالد الرشيدى said:

السلام عليكم

زكرت حضرتك ان إسلام وجب ان يظهر لانه اقل من تاريخ اليوم ب 4 ايام وهو الرقم المدخل -- هناك عقود في تواريخ اقل من تاريخ اليوم ايضا ب 3 ايام او اقل او اكثر غير اسلام لم تذكر حضرتك هل كان من المفترض ادراجها ام لا ؟؟

تقبل تحياتي وشكري علي هذه الكلمات الرائعه من حضرتك -- شكرا جزيلا

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

انت اشد مني دقه  في سؤالك التواريخ الاقل من العدد الذي كتبناه الى تاريخ اليوم

فعلا مطلوب ظهورهم

طبعا باستثناء تاريخ اليوم لانه بظهر مع العدد صفر

انت تستحق اكثر من هذه الكلمات ... لانك اهل لها

قام بنشر

اللهم اني اسألك بحق إسمك الاعظم الذي اذا دعيت به اجبت

ان تبارك للاستاذ المحترم خالد الرشيدي وتمده بالصحه والعافيه .. يارب

هل تم التغيير في هذه الجزئيه ام يوجد تغييرات اخرى ؟

            If (MyDate - .Cells(irow, 7)) <= expd And (MyDate - .Cells(irow, 7)) > 0 Then

 

=================

مامعنى هذه الجمله بارك الله لك ؟

 =CHAR(156) 

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information