- '***************** Code Start **************
- Public Function Diff2Dates(Interval As String, Date1 As Variant, Date2 As Variant, _
- Optional ShowZero As Boolean = False) As Variant
- 'Author: ) Copyright 2001 Pacific Database Pty Limited
- ' Graham R Seach MCP MVP gseach@pacificdb.com.au
- ' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
- ' This code is freeware. Enjoy...
- ' (*) Amendments suggested by Douglas J. Steele MVP
- '
- 'Description: This function calculates the number of years,
- ' months, days, hours, minutes and seconds between
- ' two dates, as elapsed time.
- '
- 'Inputs: Interval: Intervals to be displayed (a string)
- ' Date1: The lower date (see below)
- ' Date2: The higher date (see below)
- ' ShowZero: Boolean to select showing zero elements
- '
- 'Outputs: On error: Null
- ' On no error: Variant containing the number of years,
- ' months, days, hours, minutes & seconds between
- ' the two dates, depending on the display interval
- ' selected.
- ' If Date1 is greater than Date2, the result will
- ' be a negative value.
- ' The function compensates for the lack of any intervals
- ' not listed. For example, if Interval lists "m", but
- ' not "y", the function adds the value of the year
- ' component to the month component.
- ' If ShowZero is True, and an output element is zero, it
- ' is displayed. However, if ShowZero is False or
- ' omitted, no zero-value elements are displayed.
- ' For example, with ShowZero = False, Interval = "ym",
- ' elements = 0 & 1 respectively, the output string
- ' will be "1 month" - not "0 years 1 month".
- 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"
- 'Check that Interval contains only valid characters
- 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 IsNull(Date1) Then Exit Function
- If IsNull(Date2) Then Exit Function
- 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, " years", " year")
- End If
- If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
- If booCalcMonths Then
- varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
- lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
- 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, " days", " day")
- 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
- '************** Code End *****************
Da vas ne zatekne :
Ako svoj app želite instalirati na win7 64 bita
sve Private Declare , Public Declare funkcije dodajte PtrSafe Å¡to je zapravo
Private Declare PtrSafe Function
To se naročito koristi ako imate neku funkciju tipa
Private Declare PtrSafe Function GetVolumeInformation _
Lib "Kernel32.dll" Alias "GetVolumeInformationA"
Ako koristite OCX is system32 napravite bat files za registraciju pa na left click install as administrator
ako neki od files neče proći provaj kroz %windir% /wov64 folder pa bat install as administrator
poz..