السلام عليكم طلب كود

[mahmoudafefy]

السلام عليكم اريد ان اجعل خانه اليوم والتاريخ تلقائيين فى فورم الادخال المرن

 

اى عندما اضغط على اضافه سجل جديد

 

يتم كتابه اليوم والتاريخ فى خانه اليوم والتاريخ بشكل تلقائى 

 

 

 محمود.rar

[محمد ابو البـراء]

الاستاذ // mahmoudafefy

1 ) لك مني دعوة طيبة بتغيير اسمك الى اللغة العربية لسهولة التواصل ثم ان هذا ضمن سياسة المنتدى

2 ) تفضل أخي المرفق على حسب فهمي ، جرب واخبرني

محمود-braa.rar

[mahmoudafefy]

مشكور لحضرتك ولكن هناك ارقام غريبه فى خانه التاريخ لا اعرف ما هى وايضا عند عمل بحث عن طريق الفورم يأتى فى خانه التاريخ تاريخ اليوم وليس تاريخ تسجيل الاضافه الجديده 

[أبو إيمان]

بعد إذن الأستاذ  محمد أبو البراء  

هل تقصد بالتواريخ المرادة تواريخ مختلفة أم ماذا ( بمعنى أنك تريد مثلا تاريخ أمس  ويتم تثبيته ثم تاريخ اليوم وهكذا )  أي أن التسجيل في أيام مختلفة

[احمد فضيله]

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

بعد اذن كل الاخوه

الاخ الفاضل : ارجو توضيح الطلب بشكل افضل

[mahmoudafefy]

أريد عند الادخال الجديد ان يتم تحديد التاريخ تلقائيا وفى اليوم التالى عندما اقوم بعمل بحث ان اجد التاريخ المثبت ليس تاريخ اليوم التالى ولكن فى اليوم التالى عندما اقوم باضافه جديده بتم ادراج تاريم اليوم تلقائيا بمعنى

 

 

ان يتم تسجيل الاضافه بتاريخ يومها وعند البحث لا يتغير التاريخ

[أبو إيمان]

السلام عليكم 

بعد إذن العمالقة إليك هذا الكود موجود ضمن ملف قام أحد الأعضاء بإرفاقه لي 

مع الأخذ في الاعتبار بأن التاريخ هنا يظهر في العمود a بناءا على مدخلات في العمود b  يمكنك تغييره ليتناسب مع طلبك

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
     If Not Intersect(Target, Range("b1:b60000")) Is Nothing Then
      VBA.Calendar = vbCalGreg
      If IsEmpty(Target) Then
        Target(1, 2).Offset(0, -2).ClearContents
    Else
         With Target(1, 2).Offset(0, -2)
               .Value = Date
               .EntireColumn.AutoFit
           End With
       End If
End If
End Sub

[mahmoudafefy]

شكرا على مجهودك لكنك لم تفهم قصدى 

[أبو إيمان]

ما هو قصدك أخي الكريم

[mahmoudafefy]

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

[أبو إيمان]

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

تغيير التاريخ.rar

[mahmoudafefy]

تمام لكنى عندما اقوم بالادخال عن طريق فورم الادخال لا يعمل الكود 

[أبو إيمان]

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

[mahmoudafefy]

نعم هى

[احمد رائد]

في 5/10/2014 at 14:07, أبو إيمان said:

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

تغيير التاريخ.rar

شكرا اخي على هذا الكود الرائع كنت بحاجة الية جدا. ولكن هل يمكن تغيرة بحيث ان عمود التاريخ ليس مجاور لعمود البيانات اي ان البيانات عمود cمثلا والتاريخ E مع الشكر الجزيل

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

جرب الكود بهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("C1:C60000")) Is Nothing Then
        VBA.Calendar = vbCalGreg
        If IsEmpty(Target) Then
            Target.Offset(0, 2).ClearContents
        Else
            With Target.Offset(0, 2)
                .Value = Date
                .EntireColumn.AutoFit
            End With
        End If
    End If
End Sub

تقبل تحياتي

 

[احمد رائد]

في 5/2/2016 at 18:41, ياسر خليل أبو البراء said:

جرب الكود بهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("C1:C60000")) Is Nothing Then
        VBA.Calendar = vbCalGreg
        If IsEmpty(Target) Then
            Target.Offset(0, 2).ClearContents
        Else
            With Target.Offset(0, 2)
                .Value = Date
                .EntireColumn.AutoFit
            End With
        End If
    End If
End Sub

تقبل تحياتي

 

شكرا جزيلا  بارك الله فيك

[احمد رائد]

في 5/2/2016 at 18:41, ياسر خليل أبو البراء said:

جرب الكود بهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("C1:C60000")) Is Nothing Then
        VBA.Calendar = vbCalGreg
        If IsEmpty(Target) Then
            Target.Offset(0, 2).ClearContents
        Else
            With Target.Offset(0, 2)
                .Value = Date
                .EntireColumn.AutoFit
            End With
        End If
    End If
End Sub

تقبل تحياتي

 

شكرا مرة ثانية. وعندي استفسار  لو سمحت  .. هل نستطيع ان نجعل هذا الكود يعمل مع عدة مدخلات (عند ترحيل مجموعة بيانات من ورقة الى اخرى)لاني لاحظت انة يعمل عند الادخال الفردي يظهر التاريخ عندها اما عند ترحيل مجموعة بيانات مثلا فانة لايعمل(لايظهر التاريخ لهذة البيانات) .تقبل احترامي

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

أخي الكريم أفضل أن تقوم بطرح موضوع مستقل لتجد استجابة أفضل من إخوانك بالمنتدى مع إرفاق ملف يوضح المطلوب بدقة وإرفاق شكل النتائج المتوقعة

تقبل تحياتي