Service: Code-Beispiele: Quellcode
'-------------------------------------------------------------------- ' Module type..: Class module ' Module name..: CTimpStamp ' File.........: TimeStamp.cls ' Author.......: Ralf Kunsmann ' Date.........: 2001 04 07 ' Purpose......: Dealing with Time Stamps. ' Enable the user of the class to read and write either ' the complete timestamp (date and time) or only date ' or only time, while ensuring a consistent internal ' Time Stamp. '-------------------------------------------------------------------- Option Explicit Private Const sMODULENAME As String = "CTimpStamp" Private Const msDateFormatFixed As String = "yyyy mm dd" Private Const msTimeFormatFixed As String = "hh MM ss" Private mrTimeStamp As Double Private msDateFormat As String Private msTimeFormat As String '-------------------------------------------------------------------- ' Procedure.....: Class_Initialize ' Author........: Ralf Kunsmann ' Date..........: 2001 04 07 ' Purpose.......: Set the timestamp to the current time ' and set formatstrings to default values. '-------------------------------------------------------------------- Private Sub Class_Initialize() mrTimeStamp = Now() msDateFormat = "Long Date" msTimeFormat = "Long Time" End Sub '---------------------------------------------------------------------- ' Procedure.....: Update ' Author........: Ralf Kunsmann ' Date..........: 2001 07 13 ' Purpose.......: Set timestamp of this class to the current date/time. '---------------------------------------------------------------------- Public Sub Update() mrTimeStamp = Now() End Sub '-------------------------------------------------------------------- ' Procedure.....: TimeStamp ' Author........: Ralf Kunsmann ' Date..........: 2001 04 07 ' Purpose.......: Give the class user access to the double value ' repesenting the Time Stamp. '-------------------------------------------------------------------- Public Property Let TimeStamp(RHS As Double) mrTimeStamp = RHS End Property Public Property Get TimeStamp() As Double TimeStamp = mrTimeStamp End Property '-------------------------------------------------------------------- ' Procedure.....: DateFormat ' Author........: Ralf Kunsmann ' Date..........: 2001 04 07 ' Purpose.......: Give the class user access to the Date Format string. '-------------------------------------------------------------------- Public Property Let DateFormat(RHS As String) msDateFormat = RHS End Property Public Property Get DateFormat() As String DateFormat = msDateFormat End Property '-------------------------------------------------------------------- ' Procedure.....: TimeFormat ' Author........: Ralf Kunsmann ' Date..........: 2001 04 07 ' Purpose.......: Give the class user access to the Time Format string. '-------------------------------------------------------------------- Public Property Let TimeFormat(RHS As String) msTimeFormat = RHS End Property Public Property Get TimeFormat() As String TimeFormat = msTimeFormat End Property '-------------------------------------------------------------------- ' Procedure.....: DateTime ' Author........: Ralf Kunsmann ' Date..........: 2001 04 07 ' Purpose.......: Give the class user access to the Time Stamp. '-------------------------------------------------------------------- Public Property Let DateTime(RHS As Date) mrTimeStamp = RHS End Property Public Property Get DateTime() As Date ' Watch out: Return value is of data type 'Date'. Return will fail ' if current Format String are not the 'Country Settings' defaults. ' So we handle this. If InStr(msTimeFormat, "Time") > 0 And _ InStr(msDateFormat, "Short Date") > 0 Then DateTime = Format$(mrTimeStamp, msDateFormat) & " " & _ Format$(mrTimeStamp, msTimeFormat) Else DateTime = Format$(mrTimeStamp, "General Date") End If End Property '-------------------------------------------------------------------- ' Procedure........: DateTimeEx ' Author...........: Ralf Kunsmann ' Date.............: 2002 04 02 ' Purpose..........: Give the class user access to the Time Stamp. ' Result...........: String: Date and Time of current Time Stamp in ' format defined by regarding member variables. '-------------------------------------------------------------------- Public Property Get DateTimeEX() As String DateTimeEX = Format$(mrTimeStamp, msDateFormat) & " " & _ Format$(mrTimeStamp, msTimeFormat) End Property '-------------------------------------------------------------------- ' Procedure........: TheDate ' Author...........: Ralf Kunsmann ' Date.............: 2001 04 07 ' Purpose..........: Give the class user access to the Time Stamp. '-------------------------------------------------------------------- Public Property Let TheDate(RHS As Date) mrTimeStamp = CLng(RHS) + mrTimeStamp - Val(mrTimeStamp) End Property Public Property Get TheDate() As Date TheDate = Format$(Val(mrTimeStamp), "Short Date") End Property '-------------------------------------------------------------------- ' Procedure........: TheDateEx ' Author...........: Ralf Kunsmann ' Date.............: 2002 04 02 ' Purpose..........: Give access to the Date part of Time Stamp. ' Result...........: String: Date of current Time Stamp in format ' defined by regarding member variable. '-------------------------------------------------------------------- Public Property Get TheDateEx() As String TheDateEx = Format$(Val(mrTimeStamp), msDateFormat) End Property '-------------------------------------------------------------------- ' Procedure........: TheTime ' Author...........: Ralf Kunsmann ' Date.............: 2001 04 07 ' Purpose..........: Give the class user access to the Time Stamp. '-------------------------------------------------------------------- Public Property Let TheTime(RHS As Date) Dim r As Double ' Ignore date if present r = CDbl(RHS) If r > 1 Then r = r - Val(r) mrTimeStamp = Val(mrTimeStamp) + r End Property Public Property Get TheTime() As Date ' Watch out: Return value is of data type 'Date'. Return will ' fail if current Format String ' are not the 'Country Settings' defaults. So we handle this. If InStr(msTimeFormat, "Time") > 0 Then TheTime = Format$(mrTimeStamp, msTimeFormat) Else TheTime = Format$(mrTimeStamp, "Long Time") End If End Property '-------------------------------------------------------------------- ' Procedure........: TheTimeEx ' Author...........: Ralf Kunsmann ' Date.............: 2002 04 02 ' Purpose..........: Give access to the Time part of Time Stamp. ' Result...........: String: Time of current Time Stamp in format ' defined by regarding member variable. '-------------------------------------------------------------------- Public Property Get TheTimeEx() As String TheTimeEx = Format$(mrTimeStamp, msTimeFormat) End Property '---------------------------------------------------------------------- ' Procedure......: Year ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Year' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Year(RHS As Long) Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 9999 Then Exit Property iYear = RHS iMonth = VBA.Month(mrTimeStamp) iDay = VBA.Day(mrTimeStamp) mrTimeStamp = CLng(DateSerial(iYear, iMonth, iDay)) + CDbl(TheTime) End Property Public Property Get Year() As Long Year = VBA.Year(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: Month ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Month' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Month(RHS As Long) Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 12 Then Exit Property iYear = VBA.Year(mrTimeStamp) iMonth = RHS iDay = VBA.Day(mrTimeStamp) mrTimeStamp = CLng(DateSerial(iYear, iMonth, iDay)) + CDbl(TheTime) End Property Public Property Get Month() As Long Month = VBA.Month(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: Day ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Day' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Day(RHS As Long) Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 31 Then Exit Property iYear = VBA.Year(mrTimeStamp) iMonth = VBA.Month(mrTimeStamp) iDay = RHS mrTimeStamp = CLng(DateSerial(iYear, iMonth, iDay)) + CDbl(TheTime) End Property Public Property Get Day() As Long Day = VBA.Day(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: Hour ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Hour' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Hour(RHS As Long) Dim iHour As Integer Dim iMinute As Integer Dim iSecond As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 24 Then Exit Property iHour = RHS iMinute = VBA.Minute(mrTimeStamp) iSecond = VBA.Second(mrTimeStamp) mrTimeStamp = CLng(TheDate) + CDbl(TimeSerial(iHour, iMinute, iSecond)) End Property Public Property Get Hour() As Long Hour = VBA.Hour(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: Minute ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Minute' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Minute(RHS As Long) Dim iHour As Integer Dim iMinute As Integer Dim iSecond As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 59 Then Exit Property iHour = VBA.Hour(mrTimeStamp) iMinute = RHS iSecond = VBA.Second(mrTimeStamp) mrTimeStamp = CLng(TheDate) + CDbl(TimeSerial(iHour, iMinute, iSecond)) End Property Public Property Get Minute() As Long Minute = VBA.Minute(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: Second ' Author.........: Ralf Kunsmann ' Date...........: 2001 04 07 ' Purpose........: Give access to the 'Second' part of the Time Stamp. ' Result.........: Long: Current value. ' In parameters..: Long/RHS (RightHandSide): New value. '---------------------------------------------------------------------- Public Property Let Second(RHS As Long) Dim iHour As Integer Dim iMinute As Integer Dim iSecond As Integer ' Ignore invalid settings If RHS < 0 Then Exit Property If RHS > 59 Then Exit Property iHour = VBA.Hour(mrTimeStamp) iMinute = VBA.Minute(mrTimeStamp) iSecond = RHS mrTimeStamp = CLng(TheDate) + CDbl(TimeSerial(iHour, iMinute, iSecond)) End Property Public Property Get Second() As Long Second = VBA.Second(mrTimeStamp) End Property '---------------------------------------------------------------------- ' Procedure......: LeapYear ' Author.........: Ralf Kunsmann ' Date...........: 2002 02 28 ' Purpose........: Return information about year of current Time Stamp ' is a Leap Year. ' Result.........: Boolean: True if Time Stamp is Leap Year, else False. '---------------------------------------------------------------------- Public Property Get LeapYear() As Boolean Dim iYear As Integer iYear = VBA.Year(mrTimeStamp) LeapYear = (iYear Mod 4 = 0 And (iYear Mod 100 <> 0 Or _ iYear Mod 400 = 0)) End Property '---------------------------------------------------------------------- ' Procedure......: Week ' Author.........: Ralf Kunsmann ' Date...........: 2003 02 07 ' Purpose........: Return the no. of the week in year of current Time Stamp ' Result.........: Integer: Week No. (Between 1 and 53). '---------------------------------------------------------------------- Public Property Get Week( _ Optional FirstDayOfWeek As VbDayOfWeek = vbMonday, _ Optional FirstDayOfYear As VbFirstWeekOfYear = vbFirstFourDays) As Integer Week = DatePart("ww", Format$(mrTimeStamp, "General Date"), _ FirstDayOfWeek, FirstDayOfYear) End Property
Wider dem Blindflug!
Wenn Sie wissen wollen, was so alles auf Ihrem PC passiert!
Einfach - Schnell - Günstig!
Tischrechner als Software.
Jetzt herunterladen und kostenlos testen!
Effektiver Arbeiten!
Tastenkombinationen können PC-Arbeit erheblich beschleunigen.
Kleine Helfer für Sie:
Eine Reihe von kostenlosen Online-Berechnungen zur Erleichterung der täglichen Arbeit.
Wissenswertes!
Sicherheit im PC-Bereich
Es existiert eine kostenlose, einfache und äußert effektive Methode, fast alle Viren, Trojaner, Würmer ...