nach Seitenumbruch neue kopfzeile mit Code generieren

Hallo Zusammen,
folgendes Problem:
ich habe eine Zeittabelle in der die einzelnen Tage (auch Wochenenden) aufgeführt sind.
per bedingte formatierung habe ich alles Layouttechnisch schonmal angepasst.
nun soll es einen schritt weiter gehen:
in A4 bis Axxx steht das jeweilige Datum, in Spalte B bis J die Zeitrechnungen, die gemacht werden müssen.
Per Makro lass ich mir nach jedem Monat einen Seitenumbruch erstellen. (wurde nicht von mir erstellt, hab ein ähnliches gefunden und abgeändert)
nun soll mir noch per Makro beim Drucken jeweils eine andere Kopfzeile / Überschrift zugeordnet werden.
Als Überschrift soll der Monat und das Jahr des ersten Datums auf der Seite sein. (ist alles nur 1 Monat, muss also nicht der erste Eintrag sein). Format hierfür ist MMMM JJJJ
Die Zeiten stehen alle in einem Tabellenblatt und sollen auch nicht auf weitere Tabellenblätter aufgeteilt werden.
ich stelle mir das folgendermaßen vor:
Makro aufrufen, Zeilenumbrüche erstellen, bei jedem Zeilenumbruch jeweils aus der ersten Zelle (Axxx) das datum rausziehen und die als Überschrift setzen.
für eine manuelle Überschrift hab ich derzeit =TEXT(A4;"MMMM JJJJ") genommen, ist aber umständlich da jeden Abschnitt einzeln auszuwählen, die Bezugszelle zu ändern...
Hier 2 Makros, die ich gefunden habe, aber nicht weiß, wie ich die miteinander koppeln kann.
automatischer Seitenumbruch nach jedem Monat


Sub Automatischer_Seitenumbruch_nach_jedem_Monat()
Dim mon As Integer, r As Range, c As Range
ActiveSheet.Cells.PageBreak = xlPageBreakNone
Set r = Range("A4:A999")
mon = tVal(Range("A4")) 'in A4 muss ein Wert stehen!
For Each c In r
If tVal(c) > mon Then
mon = tVal(c)
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=c
End If
Next
End Sub



Function tVal(z As Range) As Long

tVal = Int(Month(z) / 1 + 0.5) + Year(z) * 12

End Function

Unterschiedliche Kopfzeile


Sub unteschiedlicheKopfzeile()
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
With Sh.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.Zoom = 100
End With
Next Sh
Application.ScreenUpdating = False
Range("C1:H37").Select
Selection.PrintOut Copies:=1
Range("C7").Select
End Sub

bei Fragen bzw. unklaren Aussagen meinerseits gerne melden!
grüße
Manuel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Druck() Dim Zelle1 As Range Dim Zelle2 As Range Set Zelle2 = Range("A4") Set Zelle1 = Range("A4") Do If Format(Zelle2.Offset(1, 0).Value, "YYYYMM") Format(Zelle1.Value, "YYYYMM") Then ActiveSheet.PageSetup.LeftHeader = Format(Zelle1.Value, "YYYY-MM") Range(Zelle1, Zelle2).EntireRow.PrintOut Set Zelle1 = Zelle2.Offset(1, 0) If Zelle1.Value = "" Then Exit Do End If Set Zelle2 = Zelle2.Offset(1, 0) Loop End Sub

Sub Druck() Dim Zelle1 As Range Dim Zelle2 As Range Set Zelle2 = Range("A4") Set Zelle1 = Range("A4") Do If Format(Zelle2.Offset(1, 0).Value, "YYYYMM") Format(Zelle1.Value, "YYYYMM") Then Sheets(Format(Zelle1.Value, "YYYY-MM")).UsedRange.Offset(1, 0).ClearContents Range(Zelle1, Zelle2).Copy Sheets(Format(Zelle1.Value, "YYYY-MM")).Cells(2, 1).PasteSpecial xlpasteall Set Zelle1 = Zelle2.Offset(1, 0) If Zelle1.Value = "" Then Exit Do End If Set Zelle2 = Zelle2.Offset(1, 0) Loop End Sub

Beliebteste Forumthreads (12 Monate)

nach Seitenumbruch neue kopfzeile mit Code generieren

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