(Aktuelle) Kalenderwoche als Dokumenteigenschaft |
|
Über die Feldfunktionen lassen sich bequem Datums- und Zeitinformationen in ein Dokument integrieren. Mit nachstehender Funktion lässt sich aus einem Datum die Kalenderwoche (nach DIN 1355) berechnen und als Eigenschaft (benutzerdefinierte Dokumenteigenschaft) dem aktuellen Dokument zur Verfügung stellen. Die Einbindung in das Dokument erfolgt dann ganz normal über das DOCPROPERTY-Feld: { DOCPROPERTY KW } Funktion zum Berechnen der Kalenderwoche aus einem Datum: Function KWoche(d As Date) As Integer 'Kalenderwochen nach DIN 1355 'Algorithmus von Christoph Kremer, Aachen Dim t& t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1) KWoche = (d - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1 End Function Damit diese Funktion in dem Dokument verwendet werden kann, wird z.B. im AutoNew-Makro die Kalenderwoche in eine benutzerdefinierte Dokumenteigenschaft (CustomDocumentProperties) gespeichert. Sub AutoNew() Dim oProp As DocumentProperty On Error Resume Next Set oProp = ActiveDocument.CustomDocumentProperties("KW") On Error GoTo 0 If oProp Is Nothing Then Set oProp = ActiveDocument.CustomDocumentProperties.Add(Name:="KW", LinkToContent:=False, _ Type:=msoPropertyTypeNumber, Value:=KWoche(Now)) End If oProp.Value = KWoche(Now) End Sub Da die Funktion KWoche jedes im Aufruf angegebene Datum verwendet, lässt sich daraus auch eine allgemein gültige Berechnungsfunktion erstellen: Sub KWocheAusDatum() Const c_Titel As String = "Kalenderwoche berechnen" Dim dDate As Date, sDate As String sDate = InputBox("Bitte ein Datum (Tag.Monat.Jahr) eingeben", c_Titel, Format(Now, "dd.mm.yyyy")) If IsDate(sDate) = True Then MsgBox "Der " & dDate & " liegt in der " & KWoche(dDate) & ". Kalenderwoche", vbInformation, c_Titel Else MsgBox "Kein gültiges Datum (Datumsformat) angegeben!", vbCritical, c_Titel End If End Sub |
Besucher: 0 online | 0 heute | 0 diesen Monat | 2227150 insgesamt | Seitenaufrufe: 34 | Letzte Änderung: 27.09.2007 | © 2001-18 Christian Freßdorf | ||||
In zweifelhaften Fällen entscheide man sich für das Richtige. Karl Kraus |
powered by phpCMS and PAX |