Microsoft Excel

Herbers Excel/VBA-Archiv

fortlaufender Kalender


Betrifft: fortlaufender Kalender von: Nadine
Geschrieben am: 18.04.2017 14:42:11

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

  

Betrifft: AW: fortlaufender Kalender von: Oberschlumpf
Geschrieben am: 18.04.2017 16:56:09

Hi Nadine,

zeig uns doch mal bitte per Upload (d)eine (Bsp-)Datei mit (Bsp-)Daten.
Danke.

Ciao
Thorsten


  

Betrifft: AW: fortlaufender Kalender von: Sepp
Geschrieben am: 18.04.2017 21:15:21

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



  

Betrifft: sollte hier her! von: Sepp
Geschrieben am: 18.04.2017 21:26:55

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



Beiträge aus den Excel-Beispielen zum Thema "fortlaufender Kalender"