1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
| Sub diffdate()
Dim test As Range
Dim diff As Integer
Dim dest As Range
Dim dte As Date
Dim jr As Integer
Dim mo As Integer
Dim an As Integer
With Worksheets("Feuil4")
Set test = .Range("A1")
Set dest = .Range("C1")
For i = 0 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
If IsDate(test.Offset(i, 0)) Then
diff = test.Offset(i, 0) - Date
If diff < 0 Then
jr = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "md")
mo = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "ym")
an = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "y")
dest.Offset(i, 0) = "Résidence avaient été accomplies " & an & " année(s), " & mo & " mois et " & jr & " jour(s)."
Else
jr = vbaDateDiff(Format(Date, "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "md")
mo = vbaDateDiff(Format(Date, "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "ym")
an = vbaDateDiff(Format(Date, "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "y")
dest.Offset(i, 0) = "Points expirent après " & an & " année(s), " & mo & " mois et " & jr & " jour(s)."
End If
End If
Next i
End With
End Sub
Function vbaDateDiff(ByVal FirstDateCell As String, ByVal SecondDateCell As String, ByVal StringCode As String) As Long
dte = FirstDateCell
dte2 = SecondDateCell
vbaDateDiff = Application.Evaluate("DATEDIF(DATEVALUE(""" & FirstDateCell & """),DATEVALUE(""" & SecondDateCell & """),""" & StringCode & """)")
End Function |