تجميد التاريخ

[أبو حنــــين]

نحتاج في بعض الحالات الى استعمال الدالة ( ) NOW

و نريد ان نحافظ على التاريخ الموجود في الملف بعد غلقه و فتحه في تاريخ آخر

هذا مثال على ذلك يحث يقوم الكود بتجميد التاريخ

ارجوا أن يستفاد منه

تجميد التاريخ.rar

تم تعديل ديسمبر 13, 2012 بواسطه أبو حنين

[الجزيرة]

بارك الله فيك

أحسنت صنعاً

[أبو حنــــين]

جزاك الله خيرا أخي الجزيرة على مروركم

[محمود رواس]

الاستاذ الفاضل ابو حنين

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

وشكرا،،،

New i-Tech softwear - V1.0.rar

[أبو حنــــين]

أخي محمود جرب نسخ هذا الكود ThisWorkbook في الحدث Workbook_BeforeClose و اخبرني بالنتيجة طبعا يجب عمل التالي

في الخلايا التي تحتوي على التاريخ يجب كتابة المعادلة مثلا =IF(U16="";"";NOW()) ثم تسحبها الى الاسفل و نفس الشيئ مع باقي خلايا التاريخ

ثم تكتب بعض القيم في خانة مبلغ السداد ليسجل البرنامج تاريخ اليوم جرب 5 او 6 قيم

ثم اغلق الملف سيطلب منك الحفظ اضغط على نعم

غير التاريخ من 13 مثلا اللا 15 او 16 و اعد فتح الملف وانظر هل التاريخ تغير او لا

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.ScreenUpdating = False

Dim sh As Worksheet, R As Boolean, cl As Range

R = False

Set sh = Sheets("البيانات")

For Each Target In Range("U10:U600,W10:W600,Y10:Y600,AA10:AA600,AC10:AC600,AE10:AE600,AG10:AG600,AI10:AI60,AK10:AK600,AM10:AM600,AO10:AO600,AQ10:AQ600")

If Target.Value > 0 Or Target.Text <> "" Then

R = True

Target.Offset(0, 1) = Format(Target.Offset(0, 1).Text, "@")

End If

Next

Application.ScreenUpdating = True

End Sub

[الـعيدروس]

السلام عليكم

جزاك الله كل خير اخي أبو حنين

ولإثراء الموضوع

Sub Ali_D()

Set R = Range("B2:B21")

For Each Rn In R

If IsDate(Rn) Then Rn.Value = Rn.Value2

Next

End Sub

تم تعديل ديسمبر 13, 2012 بواسطه عباد

[أبو حنــــين]

شرفني مرورك أخي أبو نصار

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

[محمود رواس]

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

وشكراً ،،،،

[أبو حنــــين]

السلام عليكم

الملف عندي يعمل

انظر المرفق

محمود.rar

[محمود رواس]

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

وشكراً ،،،،

[محمود رواس]

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

New i-Tech softwear - V1.0.rar

[ياسر خليل أبو البراء]

الأخ الفاضل أبو حنين

بارك الله فيك

اسمح لي بتعقيب بسيط : ما فائدة السطرين التاليين

R=True

R=False

حيث أنني لا أجد فائدة لهما ، حتى أنني قمت بحذفهما ، فعمل الكود بشكل جيد بدونهما

[أبو حنــــين]

الخطأ كان في اختيار الأعمدة التي تحتوي على القسط و ليس التاريخ

هذا الكود كان موجود في ملفك و هو خطأ :

For Each Target In Range("R15:R602,V15:V602,X15:X602 . .. . . . . . . الى آخر قيمة

و الصحيح هو :

For Each Target In Range("U15:U602,W15:W602,Y15:Y602 . .. . . الى آخر قيمة

بمعنى يجب اختيار الاعمدة التي تحتوي على قيمة القسط و ليس التاريخ

و الله اعلم

تم تعديل ديسمبر 14, 2012 بواسطه أبو حنين

[أبو حنــــين]

أخي الحبيب الأستاذ ياسر خليل

جزاك الله خيرا على هذه الملاحظة المهمة و طالما ان الكود اشتغل بدون هاذين السطرين فذلك أحسن

و كذلك يستحسن وضع الكود في الحدث : Private Sub Workbook_BeforeClose

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim sh As Worksheet

Set sh = Sheets("ورقة1")

For t = 1 To 30

If sh.Cells(t, 1).Value > 0 Or sh.Cells(t, 1).Value <> "" Then

sh.Cells(t, 1).Offset(0, 1) = Format(sh.Cells(t, 1).Offset(0, 1).Text, "@")

End If

Next

End Sub

[محمود رواس]

أشكرك جزيل الشكر استاذي الفاضل ابو حنين ، الملف يعمل .

[ياسر خليل أبو البراء]

بارك الله فيك أبو حنين ، وجعل أعمالك في ميزان حسناتك يوم القيامة