اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


hitech
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

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

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

  • Like 1
رابط هذا التعليق
شارك

  • أفضل إجابة

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

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

  • Like 3
  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information