كتابة التواريخ بشكل تلقائى

[hitech]

اريد عند كتاية الفترة من كذا حتى كذا يتم كتابة التواريخ اتوماتيك فى العمود a

كتابة الفترة اوتوماتيك.xlsx

[سليم حاصبيا]

Try This File

 

AUTO_DATE.xlsx

[hitech]

شكرا جزبلا استاذنا ربنا يبارك فى حضرتك جزاءاك الله كل خير

[عبدالفتاح في بي اكسيل]

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

Sub nn()
Dim StartDate As Date
Dim EndDate As Date
Dim NoDays As Integer
 StartDate = Range("e1").Value
 EndDate = Range("g1").Value
 NoDays = EndDate - StartDate + 1
 
 sheet1.Range("A1").CurrentRegion.Clear
 If StartDate > EndDate Then
 MsgBox "لا يمكن ان يكون تاريخ النهاية اقل من تاريخ البداية "
 Exit Sub
 End If
 Range("A1").Value = StartDate
 Range("A1").Resize(NoDays).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
 xlDay, Step:=1, Stop:=EndDate, Trend:=False

End Sub

 

كتابة الفترة اوتوماتيك.xls

[hitech]

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

[سليم حاصبيا]

اذا كنت تريده بالماكرو جرب هذا الشيء

Option Explicit

Sub Get_Date()
Dim x As Long, y As Long, t As Long, Interval
 Application.ScreenUpdating = False
 With Sheets("Sheet1")
    If .Range("B1").CurrentRegion.Rows.Count > 1 Then _
       .Range("B1").CurrentRegion.Offset(1).Clear
      '+++++++++++++++++++++++++++++++++++++++++++
     .Shapes.Range(Array("Button 1")).Select
      Selection.Characters.Text = " Click Please"
      
      '+++++++++++++++++++++++++++++++++++++++
    If Not IsDate(.Range("E1")) Or _
       Not IsDate(.Range("G1")) Then Application.ScreenUpdating = True: Exit Sub
     
        
        x = Application.Min(.Range("E1"), Range("G1"))
        y = Application.Max(.Range("E1"), Range("G1"))
    
    Interval = "Row(" & x & ":" & y & ")"
      
      .Range("B2").Resize(y - x + 1) = Evaluate(Interval)
      .Range("B1").CurrentRegion.NumberFormat = "[$-ar-lb]ddd  d mmm yyyy"
       
         'The following Lines of code between the (+) Sign Are Optional _
          You can Stop it by typing an "," Before each
          '+++++++++++++++++++++++++++++++++++++++++++++++
       t = .Range("B1").CurrentRegion.CurrentRegion.Rows.Count
      With .Range("B1").CurrentRegion.Offset(1).Resize(t - 1)
       .InsertIndent 1
       .Borders.LineStyle = 1
       .Font.Bold = True
       .Font.Size = 16
       .Interior.ColorIndex = 19
      End With
     .Shapes.Range(Array("Button 1")).Select
      Selection.Characters.Text = y - x + 1 & " Days at All"
     
        '+++++++++++++++++++++++++++++++++++++++++++
       .Cells(1, 1).Select
  End With
  Application.ScreenUpdating = True
End Sub

الملف مرفق

 

List Interval_Of Days.xlsm

[محمد حسن المحمد]

جزاكم الله خيراً أستاذنا الكريم @سليم حاصبيا على هذه الأكواد الرائعة