طلب كود ادخال التاريخ تلقائيا وعدم تغيره مع مرور الايام

[ماجد القثمي]

السلام عليكم

عندي ملف ادخال بيانات

اسم وعمر وتاريخ الاضافة

عملت كود بحيث بمجرد ما ادخل الاسم والعمر يتم تلقائيا ادخال التاريخ الحالي في وقت ادخال الاسم والعمر

والكود يعمل بشكل جيد

ولكن عند فتح الملف فيما بعد (بعد عدة ايام) تتغير التواريخ الى التاريخ الحالي عند فتح الملف

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

 

الملف مرفق به الكود

 

وشكرا

ادخال التاريخ تلقائيا وعدم تغيره مع مرور الايام.rar

[خالد الرشيدى]

اخى الكريم

استخدم الكود التالى .. وابدى ملاحظاتك

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1:B10000")) Is Nothing Then
        If Target.Offset(, -1) <> "" Then
            With Target(1, 2)
                .Value = Date
            End With
        End If
    End If
End Sub

 

[ابن الملك]

أخى العزيز  ماجد القثمى

أخى العزيز خالد الرشيدى 

فقط لاثراء الموضوع لا أكثر 

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

وشكرا

ادخال التاريخ تلقائيا وعدم تغيره مع مرور الايام.rar

[أبوبسمله]

اخوانى الافاضل ولاثراء الموضوع أكثر

كنت اقوم بانشاء ملف للعمل وقابلتنى مشكلة التاريخ وكنت لاقيت معادله بالمنتدى لضبط التاريخ بناء على خليه اخرى كانت خلية الشهر

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

بالتوفيق اخوانى

تثبيت التاريخ.rar

تم تعديل فبراير 11, 2016 بواسطه أحمد الفلاحجى

[ماجد القثمي]

أخواني الاعزاء 

شكرا جزيلا على ردودكم

الحلين هما بالضبط ما اريده وبطريقتين مختلفتين

وقد اضفت بعض التعديلات لتلائم الشروط التي احتاجها

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Last As Long
Last = Cells(Rows.Count, 2).End(xlUp).Row If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("L2:L" & Last)) Is Nothing Then
        If Target.Value = "A" Then
        If Target.Offset(, -2) <> "" Then
            With Target(1, -2)
            .Value = Format(Date, "dddd, mmmm dd, yyyy")
         End With
         End If
         End If
         End If
End Sub

 

 

 

تم تعديل فبراير 15, 2016 بواسطه ماجد القثمي