Option Compare Database



'***************** Code Start **************

Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _

Optional ShowZero As Boolean = False) As Variant



On Error GoTo Err_Diff2Dates



 Dim booCalcYears As Boolean

 Dim booCalcMonths As Boolean

 Dim booCalcDays As Boolean

 Dim booCalcHours As Boolean

 Dim booCalcMinutes As Boolean

 Dim booCalcSeconds As Boolean

 Dim booSwapped As Boolean

 Dim dtTemp As Date

 Dim intCounter As Integer

 Dim lngDiffYears As Long

 Dim lngDiffMonths As Long

 Dim lngDiffDays As Long

 Dim lngDiffHours As Long

 Dim lngDiffMinutes As Long

 Dim lngDiffSeconds As Long

 Dim varTemp As Variant



 Const INTERVALS As String = "dmyhns"



 Interval = LCase$(Interval)

 For intCounter = 1 To Len(Interval)

 If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then

 Exit Function

 End If

 Next intCounter



'Check that valid dates have been entered

 If Not (IsDate(Date1)) Then Exit Function

 If Not (IsDate(Date2)) Then Exit Function



'If necessary, swap the dates, to ensure that

'Date1 is lower than Date2

 If Date1 > Date2 Then

 dtTemp = Date1

 Date1 = Date2

 Date2 = dtTemp

 booSwapped = True

 End If



 Diff2Dates = Null

 varTemp = Null



'What intervals are supplied

 booCalcYears = (InStr(1, Interval, "y") > 0)

 booCalcMonths = (InStr(1, Interval, "m") > 0)

 booCalcDays = (InStr(1, Interval, "d") > 0)

 booCalcHours = (InStr(1, Interval, "h") > 0)

 booCalcMinutes = (InStr(1, Interval, "n") > 0)

 booCalcSeconds = (InStr(1, Interval, "s") > 0)



'Get the cumulative differences

 If booCalcYears Then

 lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _

 IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)

 Date1 = DateAdd("yyyy", lngDiffYears, Date1)

 End If



 If booCalcMonths Then

 lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _

 IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)

 Date1 = DateAdd("m", lngDiffMonths, Date1)

 End If



 If booCalcDays Then

 lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _

 IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)

 Date1 = DateAdd("d", lngDiffDays, Date1)

 End If



 If booCalcHours Then

 lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _

 IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)

 Date1 = DateAdd("h", lngDiffHours, Date1)

 End If



 If booCalcMinutes Then

 lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _

 IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)

 Date1 = DateAdd("n", lngDiffMinutes, Date1)

 End If



 If booCalcSeconds Then

 lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))

 Date1 = DateAdd("s", lngDiffSeconds, Date1)

 End If



 If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then

 varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " yıl", " yıl")

 End If



 If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then

 If booCalcMonths Then

 varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

 lngDiffMonths & IIf(lngDiffMonths <> 1, " ay", " ay")

 End If

 End If



 If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then

 If booCalcDays Then

 varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

 lngDiffDays & IIf(lngDiffDays <> 1, " gün", " gün")

 End If

 End If



 If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then

 If booCalcHours Then

 varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

 lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")

 End If

 End If



 If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then

 If booCalcMinutes Then

 varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

 lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")

 End If

 End If



 If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then

 If booCalcSeconds Then

 varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

 lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")

 End If

 End If



 If booSwapped Then

 varTemp = "-" & varTemp

 End If



 Diff2Dates = Trim$(varTemp)



End_Diff2Dates:

 Exit Function



Err_Diff2Dates:

 Resume End_Diff2Dates



End Function

=Diff2Dates("d";[Tarih1];[Tarih2])

(05/11/2008, 01:51)ozanakkaya yazdı: İki Tarih Arası Gün Ay Yıl Hesaplamaya yarayan çok kullanışlı bir örnek.