PDA

Vollständige Version anzeigen : Msgbox ein- bzw. ausschalten


MGEHRI
06.05.2011, 09:38
Hallo

Ich habe folgendes Anliegen:

Optimal wäre, wenn in meiner Datenbank beim klick auf einen bestimmten Button, der auf ein anderes Formular zugreift, eine MsgBox aufgeht - allerdings nur am letzten und am ersten Arbeitstag eines Monats.

Ich habe da folgenden Code zur Bestimmung des letzten Arbeitstages gefunden:


Public Function LastWorkDay() As Date
'-- Return the last working day of the current month

Dim Searching As Boolean
Searching = True

LastWorkDay = DateSerial(Year(Date), Month(Date) + 1, 0) '-- Start at the last day of the month
Do While Searching
If Weekday(LastWorkDay, vbMonday) > 5 Then
'-- Weekend day, back up a day
LastWorkDay = LastWorkDay - 1
'-- The search is over
Searching = False
End If
Loop

End Function


Nur hab ich's nicht hinbekommen, das auf den ersten Arbeitstag auszuweiten und mit der MsgBox zu verknüpfen.

Eine Alternative wäre, dass ich als Administrator irgendwo einen Eingabe einrichte, um die MsgBox manuell ein- bzw. auszuschalten. Aber auch da bin ich gescheitert.

Danke für Eure Hilfe!

Gruss
Marcel

Maxel
06.05.2011, 09:52
Hallo Marcel,

die Logik des ersten Arbeitstages wäre analog dem letzten:
Public Function FirstWorkDay() As Date

Dim Searching As Boolean
Searching = True

FirstWorkDay = DateSerial(Year(Date), Month(Date), 1)
Do While Searching
If Weekday(FirstWorkDay, vbMonday) > 5 Then
FirstWorkDay = FirstWorkDay + 1
Searching = False
End If
Loop

End Function
Beim Button hinterlegst Du dann folgenden Code:
If Date = FirstWorkDay or Date = LastWorkDay Then
...
End If
Allerdings sind dabei Feiertage und spezifische Nicht-Arbeitstage (Länder, Firmen) nicht berücksichtigt. Dafür empfiehlt sich die Pflege einer Arbeitstage-Tabelle, auf die dann per DMax und DMin bequem zurückgegriffen werden könnte.

MGEHRI
06.05.2011, 10:20
Hallo Maxel

Danke für Deinen Input.

Nun noch eine vielleicht etwas doofe Frage: Wo genau sollte ich diese beiden Public functions erfassen?

Leider kann ich das im Moment nicht testen, da wir weder den ersten noch den letzten Arbeitstag haben ... :p

Marcel

Atrus2711
06.05.2011, 10:22
Die Function in einem Modul deiner Datenbank, den anderwen Code in der Ereignisprozedur "Beim Klicken" des Buttons.

MGEHRI
06.05.2011, 10:34
Ich habe das nun eingebaut, aber das scheint nicht zu klappen.

Sobald ich auf den Button klicke, hängt er sich auf. Es geht gar nichts mehr - ich sehe nur die Sanduhr. Irgendwie scheint dieser Loop zu lange zu dauern ...

Wie würde denn die Lösung mit der Arbeitstage Tabelle aussehen? bzw. ich würde wohl eine Tabelle erstellen, an welchen daten die MsgBox erscheinen soll.

Danke.

Marcel

Atrus2711
06.05.2011, 11:02
Ja, das ist eine Endlosschleife. Wenn der aktuelle Tag ein Werktag ist, passiert nix, auch kein Hochzählen.
Aber keine Sorge, die dauert nicht wirklich ewig. Nur bis zum nächsten Stromausfall, oder bis ein Panzer drüberfährt.

Hier ein Ansatz für Erster und Letzter Tag ohne Endlosschleife und ohne Tabelle (also nur für Sa und So):
Public Function WorkDay(dteStichtag As Date, lngArt As Long) As Date
'dteStichtag = Datum, dessen erster bzw. letzter Werktag im Monat gesucht werden soll
'lngArt = 0 für Erster Werktag, 1 für letzter Werktag
Dim dteFirstday As Date
Dim dteLastday As Date
Dim dteLauf As Date

Select Case lngArt
Case 0 'Erster Werktag
'Grenztage ermitteln
dteFirstday = DateSerial(Year(dteStichtag), Month(dteStichtag), 1)
dteLastday = dteFirstday + 7
'Schleife
For dteLauf = dteFirstday To dteLastday
If Weekday(dteLauf, vbMonday) >= 6 Then
'Sa oder So: weitersuchen per Schleife
Else
WorkDay = dteLauf 'gefunden!
Exit For
End If
Next dteLauf

Case 1 'Letzter Werktag
'Grenztage ermitteln
dteLastday = DateAdd("m", 1, DateSerial(Year(dteStichtag), Month(dteStichtag), 1)) - 1
dteFirstday = dteLastday - 7
'Schleife (rückwärts!)
For dteLauf = dteLastday To dteFirstday Step -1
If Weekday(dteLauf, vbMonday) >= 6 Then
'Sa oder So: weitersuchen per Schleife
Else
WorkDay = dteLauf
Exit For
End If
Next dteLauf
End Select
End Function

Aufruf dann etwa so:
If Workday(Date(), 0) = Date() Then 'heute ist der erste Werktag
If Workday(Date(), 1) = Date() Then 'heute ist der letzte Werktag

Lanz Rudolf
06.05.2011, 11:56
Hallo
Weiss nicht ob ich alles richtig sehe doch ich Denke das die gezeigte routine in #1
nicht Läuft oder ewig (LOOP) :(
sehe ich was Falsch ?

MGEHRI
06.05.2011, 12:55
Hallo Atrus2711

Zuerst die gute Nachricht: Einbauen konnte ich das gemäss Deinen Instruktionen und es gibt nun keine Endlosschlaufe mehr. :)

Dann die schlechte Nachricht: Ich habe das Systemdatum auf den 2. Mai 2011 gesetzt. Das wäre ja der erste Arbeitstag im Mai und meine Msgbox sollte auftauchen. Aber das tut sie nicht ... :(

So greife ich auf die Daten zu:

If Weekday(Date, 0) = Date Then 'heute ist der erste Werktag
MsgBox ("Nach Abschluss aller Stunden bitte Abschlusshäckchen setzen! Danke."), vbOKOnly, "Monatsende"
End If

If Weekday(Date, 1) = Date Then 'heute ist der letzte Werktag
MsgBox ("Nach Abschluss aller Stunden bitte Abschlusshäckchen setzen! Danke."), vbOKOnly, "Monatsende"
End If



Stimmt da was nicht?

Marcel

Atrus2711
06.05.2011, 12:59
Wieso nutzt du Weekday, wenn meine mühsam produzierte Funktion Workday heißt? Weekday liefert was anderes. :)

Scorefun
06.05.2011, 13:01
Die Funktion heißt doch Workday und nicht Weekday, oder? ;)

MGEHRI
06.05.2011, 13:06
Tja, so was nennt sich dann Selbstüberlistung ... :D

Sorry guys, klappt ausgezeichnet - funktioniert wie gewünscht!

Vielen Dank für Eure Unterstützung

Marcel