Prikazi cijelu temu 29.05.2012 10:15
Amelasar Van mreze
Clan
Registrovan od:07.04.2011
Lokacija:SARAJEVO


Predmet:Re: Razlika izmedju dva date/time podatka
PreuzmiIzvorni kôd (Text):
  1. '***************** Code Start **************
  2. Public Function Diff2Dates(Interval As String, Date1 As Variant, Date2 As Variant, _
  3. Optional ShowZero As Boolean = False) As Variant
  4. 'Author:    ) Copyright 2001 Pacific Database Pty Limited
  5. '           Graham R Seach MCP MVP gseach@pacificdb.com.au
  6. '           Phone: +61 2 9872 9594  Fax: +61 2 9872 9593
  7. '           This code is freeware. Enjoy...
  8. '           (*) Amendments suggested by Douglas J. Steele MVP
  9. '
  10. 'Description:   This function calculates the number of years,
  11. '               months, days, hours, minutes and seconds between
  12. '               two dates, as elapsed time.
  13. '
  14. 'Inputs:    Interval:   Intervals to be displayed (a string)
  15. '           Date1:      The lower date (see below)
  16. '           Date2:      The higher date (see below)
  17. '           ShowZero:   Boolean to select showing zero elements
  18. '
  19. 'Outputs:   On error: Null
  20. '           On no error: Variant containing the number of years,
  21. '               months, days, hours, minutes & seconds between
  22. '               the two dates, depending on the display interval
  23. '               selected.
  24. '           If Date1 is greater than Date2, the result will
  25. '               be a negative value.
  26. '           The function compensates for the lack of any intervals
  27. '               not listed. For example, if Interval lists "m", but
  28. '               not "y", the function adds the value of the year
  29. '               component to the month component.
  30. '           If ShowZero is True, and an output element is zero, it
  31. '               is displayed. However, if ShowZero is False or
  32. '               omitted, no zero-value elements are displayed.
  33. '               For example, with ShowZero = False, Interval = "ym",
  34. '               elements = 0 & 1 respectively, the output string
  35. '               will be "1 month" - not "0 years 1 month".
  36.  
  37. On Error GoTo Err_Diff2Dates
  38.  
  39.    Dim booCalcYears As Boolean
  40.    Dim booCalcMonths As Boolean
  41.    Dim booCalcDays As Boolean
  42.    Dim booCalcHours As Boolean
  43.    Dim booCalcMinutes As Boolean
  44.    Dim booCalcSeconds As Boolean
  45.    Dim booSwapped As Boolean
  46.    Dim dtTemp As Date
  47.    Dim intCounter As Integer
  48.    Dim lngDiffYears As Long
  49.    Dim lngDiffMonths As Long
  50.    Dim lngDiffDays As Long
  51.    Dim lngDiffHours As Long
  52.    Dim lngDiffMinutes As Long
  53.    Dim lngDiffSeconds As Long
  54.    Dim varTemp As Variant
  55.  
  56.    Const INTERVALS As String = "dmyhns"
  57.  
  58. 'Check that Interval contains only valid characters
  59.    Interval = LCase$(Interval)
  60.    For intCounter = 1 To Len(Interval)
  61.       If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
  62.          Exit Function
  63.       End If
  64.    Next intCounter
  65.  
  66. 'Check that valid dates have been entered
  67.    If IsNull(Date1) Then Exit Function
  68.    If IsNull(Date2) Then Exit Function
  69.    If Not (IsDate(Date1)) Then Exit Function
  70.    If Not (IsDate(Date2)) Then Exit Function
  71.  
  72. 'If necessary, swap the dates, to ensure that
  73. 'Date1 is lower than Date2
  74.    If Date1 > Date2 Then
  75.       dtTemp = Date1
  76.       Date1 = Date2
  77.       Date2 = dtTemp
  78.       booSwapped = True
  79.    End If
  80.  
  81.    Diff2Dates = Null
  82.    varTemp = Null
  83.  
  84. 'What intervals are supplied
  85.    booCalcYears = (InStr(1, Interval, "y") > 0)
  86.    booCalcMonths = (InStr(1, Interval, "m") > 0)
  87.    booCalcDays = (InStr(1, Interval, "d") > 0)
  88.    booCalcHours = (InStr(1, Interval, "h") > 0)
  89.    booCalcMinutes = (InStr(1, Interval, "n") > 0)
  90.    booCalcSeconds = (InStr(1, Interval, "s") > 0)
  91.  
  92. 'Get the cumulative differences
  93.    If booCalcYears Then
  94.       lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
  95.               IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
  96.       Date1 = DateAdd("yyyy", lngDiffYears, Date1)
  97.    End If
  98.  
  99.    If booCalcMonths Then
  100.       lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
  101.               IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
  102.       Date1 = DateAdd("m", lngDiffMonths, Date1)
  103.    End If
  104.  
  105.    If booCalcDays Then
  106.       lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
  107.               IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
  108.       Date1 = DateAdd("d", lngDiffDays, Date1)
  109.    End If
  110.  
  111.    If booCalcHours Then
  112.       lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
  113.               IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
  114.       Date1 = DateAdd("h", lngDiffHours, Date1)
  115.    End If
  116.  
  117.    If booCalcMinutes Then
  118.       lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
  119.               IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
  120.       Date1 = DateAdd("n", lngDiffMinutes, Date1)
  121.    End If
  122.  
  123.    If booCalcSeconds Then
  124.       lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
  125.       Date1 = DateAdd("s", lngDiffSeconds, Date1)
  126.    End If
  127.  
  128.    If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
  129.       varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
  130.    End If
  131.  
  132.    If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
  133.       If booCalcMonths Then
  134.          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
  135.                    lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
  136.       End If
  137.    End If
  138.  
  139.    If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
  140.       If booCalcDays Then
  141.          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
  142.                    lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
  143.       End If
  144.    End If
  145.  
  146.    If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
  147.       If booCalcHours Then
  148.          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
  149.                    lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
  150.       End If
  151.    End If
  152.  
  153.    If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
  154.       If booCalcMinutes Then
  155.          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
  156.                    lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
  157.       End If
  158.    End If
  159.  
  160.    If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
  161.       If booCalcSeconds Then
  162.          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
  163.                    lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
  164.       End If
  165.    End If
  166.  
  167.    If booSwapped Then
  168.       varTemp = "-" & varTemp
  169.    End If
  170.  
  171.    Diff2Dates = Trim$(varTemp)
  172.  
  173. End_Diff2Dates:
  174.    Exit Function
  175.  
  176. Err_Diff2Dates:
  177.    Resume End_Diff2Dates
  178.  
  179. End Function
  180. '************** Code End *****************


Primjeri pozivanja:

?Diff2Dates("y", #06/01/1998#, #06/26/2002#)
4 years
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#)
4 years 25 days
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#, True)
4 years 0 months 25 days
?Diff2Dates("d", #06/01/1998#, #06/26/2002#)
1486 days

?Diff2Dates("h", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours
?Diff2Dates("hns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours 47 minutes 33 seconds
?Diff2Dates("dhns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
1 day 18 hours 47 minutes 33 seconds

?Diff2Dates("ymd",#12/31/1999#,#1/1/2000#)
1 day
?Diff2Dates("ymd",#1/1/2000#,#12/31/1999#)
-1 day
?Diff2Dates("ymd",#1/1/2000#,#1/2/2000#)
1 day
Pozdrav, Amela