2
www.ChF-Online.de  

(Jahres-) Kalender erstellen

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
aktiv aktiv Verschiedenes
 Dateiname ohne Endung
 Dokumentstrukturanzeige
 Fenster anordnen
 Fensterliste
 Fensterliste (II)
aktiv  Kalender erstellen
 Kommentarinformationen
 Lesezeichen
 Beliebigen Ordner öffnen
 Position der Einfügemarke
 Seitenanfang/-ende
 Shapes ansprechen
 Sicherheitskopien erstellen
 Word-Startparameter
 Word-Startparameter II
 Startordner "Bild einfügen"
 Tags finden u. bearbeiten
 Tags finden/bearbeiten (II)
 Text2WordArt
 Textbausteine verwenden
 Textmarken (I)
 Textmarken (II)
 Überschrift zu Textmarke
 VBA-Konverter
 Wasserzeichen
 Zeichen tauschen
 Feld-Arbeiten
 Form-Sachen
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Getestet unter Word97Getestet unter Word2000Getestet unter WordXP  
Beispiel anzeigen
Makro/Datei speichern
Print

In VBA stehen verschiedene Funktionen zur Berechnung und Darstellung von Datumsangaben zur Verfügung.
Zur Verarbeitung eines Datums kann eine Variable vom Datentyp Date verwendet werden, da diese ein Datum im Bereich vom 01. Januar 100 bis zum 31. Dezember 9999 und eine Uhrzeit im Bereich von 0:00:00 bis 23:59:59 aufnehmen kann.
Die formatierte Ausgabe einzelner Datumsangaben (Jahr, Monat, Tag) erfolgt über die Funktion Format() entsprechend der in der Hilfe beschriebenen Syntax. Eine weitere nützliche Hilfe ist die Weekday-Funktion, mit deren Hilfe der Wochentag (als Zahl) eines bestimmten Datums zurückgeliefert wird.

Als Beispiel für die Verwendung dieser Funktionen wird mit dem folgenden Makro ein Kalender erstellt, der für jeden Monat die Wochentage (mit Wochentagsnamen) auflistet und dabei Platz für kurze Einträge pro Tag besitzt (Siehe Beispiel).

Für den Kalender lassen sich folgende Angaben festlegen:

  • Jahr des Kalenderbeginns
  • Anfangsmonat
  • Anzahl der anzuzeigenden Monate

Aus diesen Angaben wir das Anfangsdatum erzeugt und der Variablen data vom Typ Date zugewiesen. Mit Hilfe der Funktionen Weekday(data) und Format(data, "d") werden die verschiedenen benötigten Datumsformate (Monatsname, Tag, Wochentag) ermittelt und in die entsprechenden Tabellenzellen eingetragen.

Zum Schluss werden aus den Kalenderangaben die Informationen für die Kopfzeile des Kalenders berechnet und eingetragen.

Attribute VB_Name = "Kalender"
Option Explicit 
Dim tblTable As Table
Dim strMonat(12) As String 
Dim data As Date 
Dim strMonatstrActTag(12, 31) As Integer 
Dim strWochentag, strActMonat, strActTag As String 
Dim oDoc As Document
Dim tblActCell As Cell
Dim intStartMonat, intJahr, intStartJahr, intMaxMonate As Integer 
Dim intMonat, intSpalte As Integer 
Dim strmsg As String 
Const cTitle = "Kalender erstellen"
System.Cursor = wdCursorWait 
' Daten abfragen 
Do 
  strmsg = "In welchem Jahr beginnt der Kalendar?"
  intStartJahr = InputBox(strmsg, cTitle, Year(Now))
  If intStartJahr = "" Then End 
Loop While IsNumeric(intStartJahr) = False 
Do 
  strmsg = "Mit welchem Monat soll der Kalender beginnen (1-12)?"
  intStartMonat = InputBox(strmsg, cTitle, Month("1/ 1/" & intStartJahr))
  If intStartJahr = "" Then End 
Loop While (Not IsNumeric(intStartMonat)) Or 1> intStartMonat Or intStartMonat >12
Do 
  strmsg = "Wie viele Monate sollen angezeigt werden (1-12)?"
  intMaxMonate = InputBox(strmsg, cTitle, "12")
  If intStartJahr = "" Then End 
Loop While IsNumeric(intMaxMonate) = False 
intJahr = intStartJahr
' Datum des ersten Kalendertages ermitteln 
data = "1/ " & Val(intStartMonat) & "/ " & intJahr
strWochentag = Weekday(data)
' Neues Dokument anlegen und ausrichten 
Set oDoc = Documents.Add
oDoc.PageSetup.PaperSize = wdPaperA4 
oDoc.PageSetup.Orientation = wdOrientLandscape 
'GoTo weiter: 
' Tabelle anlegen 
Set tblTable = oDoc.Tables.Add(Selection.Range, 32, intMaxMonate)
With tblTable
  intMonat = intStartMonat
  For intSpalte = 1 To intMaxMonate
    ' Jahreswechsel
    If intMonat = 13 Then 
      intMonat = 1
      intJahr = intJahr + 1
    End If 
    'Monatsnamen ermitteln
    strMonat(intMonat) = Format("1/" & intMonat & "/ " & intJahr, "mmmm")
    DoEvents 
    Set tblActCell = .Cell(1, intSpalte)
    ' Kopfzeile mit Monatsnamen formatieren
    With tblActCell
      .Range.InsertAfter strMonat(intMonat)
      .Range.Font.Bold = True 
      .Range.Font.Size = 11
      .Shading.BackgroundPatternColor = wdColorGray25
    End With 
    ' Jahreswechsel hervorheben
    If intMonat = 12 Then 
      .Columns(intSpalte).Borders(wdBorderRight).LineStyle = wdLineStyleDoubleWavy
    End If 
    strActMonat = Format(data, "mm")
    ' Alle Tage eines Monats bearbeiten
    Do While Val(strActMonat) = intMonat
      strActTag = Format(data, "dd")
      Set tblActCell = .Cell(strActTag + 1, intSpalte)
      With tblActCell
        .Range.InsertAfter Format(data, "d")
        .Range.Font.Bold = False 
        .Range.Font.Size = 8
        .Height = 12
        .VerticalAlignment = wdCellAlignVerticalCenter 
        ' Tageskürzel ermitteln und eintragen
        Select Case Weekday(data)
        Case vbSunday 
          .Range.InsertAfter " So"
          ' Sonntage werden hervorgehoben
          .Range.Shading.BackgroundPatternColor = wdColorGray25
        Case vbMonday 
          .Range.InsertAfter " Mo"
        Case vbTuesday 
          .Range.InsertAfter " Di"
        Case vbWednesday 
          .Range.InsertAfter " Mi"
        Case vbThursday 
          .Range.InsertAfter " Do"
        Case vbFriday 
          .Range.InsertAfter " Fr"
        Case vbSaturday 
          .Range.InsertAfter " Sa"
        End Select 
      End With 
      data = data + 1
      strActMonat = Format(data, "mm")
    Loop 
    ' nächster Monat
    intMonat = intMonat + 1
  Next intSpalte
End With 
weiter:
' Überschrift in Kopfzeile erstellen 
Dim oHeader As View
Dim msg As String 
Dim intEndMonat, intEndJahr, int_berlauf As Integer 
' Jahreswechsel berücksichtigen und korrekten Endmonat ermitteln 
If intStartMonat + intMaxMonate - 1 > 12 Then 
  int_berlauf = Int((intStartMonat + intMaxMonate - 1) / 12)
  intEndMonat = intStartMonat + intMaxMonate - 1 - 12 * int_berlauf
  intEndJahr = intStartJahr + int_berlauf
ElseIf intStartMonat + intMaxMonate - 1 = 12 Then
  intEndMonat = intStartMonat + intMaxMonate - 1
  intEndJahr = intStartJahr
Else 
  intEndMonat = intStartMonat + intMaxMonate - 1
  intEndJahr = intStartJahr + Int((intStartMonat + intMaxMonate - 1) / 12)
End If 
' Text für die Kopfzeile zusammensetzen 
msg = "Kalenderübersicht von " & intStartMonat & " / " & intStartJahr & " bis " _
 & intEndMonat & " / " & intEndJahr
' _berschrift in Kopfzeile einfügen und formatieren 
Set oHeader = oDoc.ActiveWindow.View
oHeader.SplitSpecial = wdPaneCurrentPageHeader 
With Selection
  .InsertAfter msg
  .Font.Size = 12
  .Font.Bold = True 
  .Paragraphs.Alignment = wdAlignParagraphCenter 
End With 
' Ansicht zurücksetzen 
System.Cursor = wdCursorNormal 
oHeader.SplitSpecial = wdPaneNone 
End Sub 

Eine erweiterte Version als Dokumentvorlage findet Ihr Link hier.
Diese Version bietet folgende Erweiterungen:

  • Ausgabe kann jetzt auf mehrere Seiten/Blätter verteilt werden
  • mehr als 12 Monate möglich
  • die wichtigsten Feiertage werden berechnet und eingetragen
  • Mondphasen werden angezeigt
  • bessere Benutzerführung durch eine fertige Dokumentvorlage (.dot)


 Besucher: 0 online  |  0 heute  |  0 diesen Monat  |  2228608 insgesamt | Seitenaufrufe: 79   Letzte Änderung: 24.06.2006 © 2001-18 Christian Freßdorf
  Großes muß groß beurteilt werden. Sonst wird es meinen, es sei ein Fehler des Gegenstandes, was in Wirklichkeit unser eigener ist.
Lucius Seneca
 powered by phpCMS and PAX