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

[ehabaf2]

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

مسحوبات الخطوط.xlsx

[محمد هشام.]

تفضل اخي 

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WRng As Range, WRng2 As Range
Dim rg As Range, rg2 As Range
Dim ST1 As Integer, ST2 As Integer
Set WRng = Intersect(Application.ActiveSheet.Range("B8:B1000"), Target)
Set WRng2 = Intersect(Application.ActiveSheet.Range("d8:d1000"), Target)
On Error Resume Next
ST1 = 1
ST2 = 1

If Not WRng Is Nothing Then
    Application.EnableEvents = False
    For Each rg In WRng
        If Not VBA.IsEmpty(rg.Value) Then
            rg.Offset(0, ST1).Value = Now
            rg.Offset(0, ST1).NumberFormat = "dd-mm-yyyy HH:mm"
        Else
            rg.Offset(0, ST1).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
If Not WRng2 Is Nothing Then
    Application.EnableEvents = False
    For Each rg2 In WRng2
        If Not VBA.IsEmpty(rg2.Value) Then
            rg2.Offset(0, ST2).Value = Now
            rg2.Offset(0, ST2).NumberFormat = "dd-mm-yyyy HH:mm"
        Else
            rg2.Offset(0, ST2).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

 

مسحوبات الخطوط.xlsm

[ehabaf2]

الاستاذ الفاضل محمد هشام اكرر شكري لحضرتك الكود رائع و هو فعلا ده المطلوب 

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

يعني ممكن اكرر العملية فى اكتر من مكان داخل الشيت

زادك الله من فضله و  علمه

تم تعديل فبراير 26, 2023 بواسطه ehabaf2

[ehabaf2]

لو سمحت استاذنا  الفاضل Mohamed Hicham  ممكن تعديل الكود لتكرار العمل فى اكتر من مكان فى الشيت

كود اخفاء2.xlsm

تم تعديل فبراير 27, 2023 بواسطه ehabaf2