PDA

Vollständige Version anzeigen : Datumswerte abfragen: 15ter Tag des Monats ...


KlTroe
10.07.2006, 09:10
Hallo zusammen,

zuerst vielen Dank für Eure Zeit!

Heute möchte ich per VBA spezielle Datumswerte eines Feldes (Feld1) abfragen.

If Me.Feld1 = "?1er Tag des Monats" Then MsgBox ...
If Me.Feld1 = "?15ter Tag des Monats" Then MsgBox ...
If Me.Feld1 = "?letzter Tag des Monats" Then MsgBox ...

If Me.Feld1 = "?1. Donnerstag des Monats" Then MsgBox ...

If Me.Feld1 = "?Beginn erstes Quartal" Then MsgBox ...

If Me.Feld1 = "?Hälfte des Jahres" Then MsgBox ...

Besten Dank - schönen Tag noch.

Gruß
Klaus

TommyK
10.07.2006, 10:32
Hallo Klaus,

hier erstmal einen Denkanstoß:
If Month(Me.Text0) = Month(Date) Then
If Day(Me.Text0) = 1 Then MsgBox "1.Tag des Monats"
End If

If Month(Me.Text0) = Month(Date) Then
If Day(Me.Text0) = 15 Then MsgBox "15.Tag des Monats"
End If

If Month(Me.Text0) = Month(Date) Then
If LastDayMonth(Me.Text0) = Me.Text0 Then MsgBox "letzter Tag des Monats"
End If

If Month(Me.Text0) = Month(Date) Then
If FirstDayQuartal(Me.Text0) = Me.Text0 Then MsgBox "1. Tag des Quartals"
End If

If Month(Me.Text0) = Month(Date) Then
If FirstDayHalfYear(Me.Text0) = Me.Text0 Then MsgBox "1. Tag des Halbjahres"
End If
Diese Hilfsfunktionen werden noch benötigt:
Public Function LastDayMonth(dateDatum As Date)
'*******************************************
'Name: LastDayMonth (Function)
'Purpose: Ermittelt den letzten Tag des Monats ausgehend von dateDatum
'Author: Thomas Keßler
'Date: Februar 12, 2004, 11:45:00
'Inputs: dateDatum= Datum ab dem gerechnet werden soll
'Output:
'*******************************************
LastDayMonth = DateSerial(Year(dateDatum), Month(dateDatum) + 1, 0)

End Function

Public Function FirstDayQuartal(dateDatum As Date)
'*******************************************
'Name: FirstDayQuartal (Function)
'Purpose: Ermittelt den ersten Tag des aktuellen Quartals ausgehend von dateDatum
'Author: Thomas Keßler
'Date: Februar 12, 2004, 11:45:00
'Inputs: dateDatum= Datum ab dem gerechnet werden soll
'Output:
'*******************************************
Dim intQtr As Integer
Dim intMonth As Integer
Dim intYear As Integer

intYear = Year(dateDatum)
intQtr = Int((Month(dateDatum) - 1) / 3)
intMonth = (intQtr * 3) + 1

FirstDayQuartal = DateSerial(intYear, intMonth, 1)

End Function

Public Function FirstDayHalfYear(dateDatum As Date)
'*******************************************
'Name: FirstDayHalfYear (Function)
'Purpose: Ermittelt den ersten Tag des aktuellen Halbjahres ausgehend von dateDatum
'Author: Thomas Keßler
'Date: Februar 12, 2004, 11:45:00
'Inputs: dateDatum= Datum ab dem gerechnet werden soll
'Output:
'*******************************************

Dim intHbj As Integer
Dim intMonth As Integer
Dim intYear As Integer

intYear = Year(dateDatum)
intHbj = Int((Month(dateDatum) - 1) / 6)
intMonth = (intHbj * 6) + 1

FirstDayHalfYear = DateSerial(intYear, intMonth, 1)

End Function

KlTroe
11.07.2006, 09:36
Hi Tommy,

vielen Dank für Deine Mühe und Deine Denkanstöße!
Schönen Tag

Gruß
Klaus

TommyK
11.07.2006, 12:53
Hallo Klaus,

hier noch der fehlende Teil für die Version z.B. 1. Donnerstag des Monats:
Die folgende Funktion rechnet das aus:
Public Enum Wochentag
Montag = 1
Dienstag = 2
Mittwoch = 3
Donnerstag = 4
Freitag = 5
Samstag = 6
Sonntag = 7
End Enum

Public Function CalcWeekday(intWeekday As Wochentag, intNumber As Integer, _
dtDate As Date) As Date
'---------------------------------------------------------------------------------------
' Procedure : CalcWeekday
' DateTime : 11.07.2006 12:00
' Author : TommyK
' Purpose : errechnet einen bestimmten Wochentag
' Inputs : intWeekday=Auswahl des Wochentages der ermittelt werden soll
' intNumber=Zahl die den WT bestimmt z.B. 2. Donnerstag
' dtDate=das Bezugsdatum, bei nicht Angabe wird das aktuelle Datum verwendet.
' Output : das errechnte Datum
' Example : CalcWeekday(Montag,2)
' Ergebnis wäre für den 2. Montag ausgehend von heute 11.07.2006 = 10.07.2006
'---------------------------------------------------------------------------------------

On Error GoTo CalcWeekday_Error

Dim intMonth As Integer, intYear As Integer, i As Integer, j As Integer, intWT As Integer
Dim intStart As Integer, intEnd As Integer

'Wenn Zahl des Wochentages größer 5 dann 4
If intNumber > 5 Then intNumber = 4

intMonth = Month(dtDate)
intYear = Year(dtDate)
intStart = Day(DateSerial(intYear, intMonth, 1))
intEnd = Day(DateSerial(intYear, intMonth + 1, 0))

For i = intStart To intEnd
intWT = Weekday(DateSerial(intYear, intMonth, i), vbMonday)
If intWT = intWeekday Then
j = j + 1
If j = intNumber Then
CalcWeekday = Format(DateSerial(intYear, intMonth, i), "dd.mm.yyyy")
Exit For
End If
End If
Next i

On Error GoTo 0
Exit Function

CalcWeekday_Error:
Dim strErrString As String
strErrString = "Error Information..." & vbCrLf
strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
strErrString = strErrString & "Description: " & Err.Description
MsgBox strErrString, vbCritical + vbOKOnly, "Error in procedure CalcWeekday"
End Function
Aufruf z.B.
MsgBox CalcWeekday(Donnerstag, 1, "11.07.2006")
Würde als Ergenis den 06.07.2006 bringen.

KlTroe
06.08.2006, 20:37
Besten Dank Tommy!!

Alles Gute

Gruß
Klaus