Benutzerdefinierte/spezielle Kopf- & Fußzeile

Hallo ale zusammen,
ich führe eine riesige Liste von Büchern und etc. Die Breite einer Tabelle entspricht die Breite eines A4 Blattes, das ist aber nicht das Problem. Die Gesamtliste ist etwa 280 Seiten lang, wird immer wieder ergänzt und wird somit immer länger.
Beim Einfügen von Kopf- und Fußzeile habe ich die verschiedene Möglichkeiten an Informationen, diese einzufügen.
Nun will ich aber dass in der Kopfzeile der ERSTE Wert und der LETZTE Wert jeder Seite einfügt, so wie in einem Wörterbuch.
Im Web hab ich danach gesucht und nicht wirklich sowas gefunden. Denk mal das dass ohne VBA nicht geht, nur wie geht das überhaupt?
Hoffe ich war verständlich und mir kann geholfen werden.
Danke und LG :-)
Urmila

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Fussnote() Dim Ws As Worksheet For Each Ws In ActiveWorkbook.Worksheets If Ws.Name "Mein Sheet" Then With Ws.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = " Blablabl " .CenterFooter = "" .RightFooter = "Seite - " & "&P" & " -" .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 End With End If Next End Sub

Sub tt() Dim i As Integer, s1 As String, s2 As String Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview For i = 1 To ActiveSheet.HPageBreaks.Count Select Case i Case 1 s1 = Cells(2, 1).Text s2 = ActiveSheet.HPageBreaks(i).Location.Offset(-1).Text ActiveSheet.PageSetup.LeftHeader = s1 & "-" & s2 Case Else s1 = ActiveSheet.HPageBreaks(i - 1).Location.Text s2 = ActiveSheet.HPageBreaks(i).Location.Offset(-1).Text ActiveSheet.PageSetup.LeftHeader = s1 & "-" & s2 End Select ActiveSheet.PrintOut from:=i, to:=i Next s1 = ActiveSheet.HPageBreaks(i - 1).Location.Text s2 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Text ActiveSheet.PageSetup.LeftHeader = s1 & "-" & s2 ActiveSheet.PrintOut from:=i, to:=i ActiveWindow.View = xlNormalView Application.ScreenUpdating = True End Sub

Sub tt() Dim i As Integer, s1 As String, s2 As String, p p = Application.Dialogs(xlDialogPrinterSetup).Show If p = False Then Exit Sub 'Abbrechen gewählt Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview With ActiveSheet For i = 1 To .HPageBreaks.Count Select Case i Case 1 s1 = .Cells(2, 1).Text s2 = .HPageBreaks(i).Location.Offset(-1).Text .PageSetup.LeftHeader = s1 & "-" & s2 Case Else s1 = .HPageBreaks(i - 1).Location.Text s2 = .HPageBreaks(i).Location.Offset(-1).Text .PageSetup.LeftHeader = s1 & "-" & s2 End Select .PrintOut from:=i, To:=i Next s1 = .HPageBreaks(i - 1).Location.Text s2 = .Cells(Rows.Count, 1).End(xlUp).Text .PageSetup.LeftHeader = s1 & "-" & s2 .PrintOut from:=i, To:=i End With ActiveWindow.View = xlNormalView Application.ScreenUpdating = True End Sub

Hallo,
für 4 Buchstaben aus Spalte B.
Für andere Spalten die Offsets anpassen.

Sub tt()
Dim i As Integer, s1 As String, s2 As String, p
p = Application.Dialogs(xlDialogPrinterSetup).Show
If p = False Then Exit Sub  'Abbrechen gewählt
Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview
With ActiveSheet
For i = 1 To .HPageBreaks.Count
Select Case i
Case 1
s1 = Left(.Cells(2, 1).Offset(, 1).Text, 4)
s2 = Left(.HPageBreaks(i).Location.Offset(-1, 1).Text, 4)
.PageSetup.LeftHeader = s1 & "-" & s2
Case Else
s1 = Left(.HPageBreaks(i - 1).Location.Offset(, 1).Text, 4)
s2 = Left(.HPageBreaks(i).Location.Offset(-1, 1).Text, 4)
.PageSetup.LeftHeader = s1 & "-" & s2
End Select
.PrintOut from:=i, To:=i
Next
s1 = Left(.HPageBreaks(i - 1).Location.Offset(, 1).Text, 4)
s2 = Left(.Cells(Rows.Count, 1).End(xlUp).Offset(, 1).Text, 4)
.PageSetup.LeftHeader = s1 & "-" & s2
.PrintOut from:=i, To:=i
End With
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Benutzerdefinierte/spezielle Kopf- & Fußzeile

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread