fortlaufender Kalender

Hallo liebe Excel Gemeinde,
ich stoße gerade an die Grenzen meiner VBA Kenntnisse.
Ich möchte in Excel eine Art fortlaufenden Kalender mittels VBA programmieren.
Das soll wie folgt aussehen:
Ich habe eine Excel-Tabelle mit allen Tagen eines Jahres und wenn das aktuelle Datum "abgelaufen" ist, soll automatisch am Ende der Tabelle (in der nächsten freien Spalte) ein neuer Tag hinzugefügt werden. (D.h. Wenn der heutige Tag vorbei ist und in der aktuell letzten Spalte der 31.12.2017 steht, soll der 1.1.2018, in die darauffolgende freie Spalte, hinzugefügt werden.)
Des Weiteren sollen die Formatierungen in den darunterliegenden Zeilen mit übernommen werden.
Gibt es da eine Möglichkeit? Bin am verzweifeln :)
Ich hoffe auf eure Hilfe
Ganz liebe Grüße
Nadine

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nadine,
vom Prinzip her so.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
Call add_date
End Sub

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const c_days_ahead As Long = 183  'Anzahl der Tage die maximal über das heutige Datum hinaus angelegt werden sollen

Sub add_date()
Dim lngAct As Long, lngMax As Long, lngC As Long, lngN As Long, lngCol As Long, lngRow As Long
Dim rngSel As Range

Set rngSel = ActiveCell

lngRow = 1 'Zeile mit dem Datum - Anpassen!
lngAct = Date

With Sheets("Kalender") 'Name des Kalenderblattes - Anpassen!
  lngCol = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column
  lngN = lngCol
  lngMax = .Cells(lngRow, lngCol)
  If lngMax < lngAct + c_days_ahead Then
    For lngC = lngMax + 1 To lngAct + c_days_ahead
      lngN = lngN + 1
      .Cells(lngRow, lngN) = CDate(lngC)
    Next
    .Columns(lngCol).Copy
    .Range(.Cells(1, lngCol), .Cells(1, lngN)).EntireColumn.PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    rngSel.Select
  End If
End With

Set rngSel = Nothing
End Sub

Gruß Sepp

' ********************************************************************** ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Workbook_Open() Call add_date End Sub ' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Private Const c_days_ahead As Long = 183 'Anzahl der Tage die maximal über das heutige Datum hinaus angelegt werden sollen Sub add_date() Dim lngAct As Long, lngMax As Long, lngC As Long, lngN As Long, lngCol As Long, lngRow As Long Dim rngSel As Range Set rngSel = ActiveCell lngRow = 1 'Zeile mit dem Datum - Anpassen! lngAct = Date With Sheets("Kalender") 'Name des Kalenderblattes - Anpassen! lngCol = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column lngN = lngCol lngMax = .Cells(lngRow, lngCol) If lngMax < lngAct + c_days_ahead Then For lngC = lngMax + 1 To lngAct + c_days_ahead lngN = lngN + 1 .Cells(lngRow, lngN) = CDate(lngC) Next .Columns(lngCol).Copy .Range(.Cells(1, lngCol), .Cells(1, lngN)).EntireColumn.PasteSpecial xlPasteFormats Application.CutCopyMode = False rngSel.Select End If End With Set rngSel = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread