Hilfe bei Kopf und Fußzeile

Hallo, benötige mal wieder eure Hilfe. Ich brauche eine Lösung für folgendes Problem. Für ein Tabellenblatt muss ich Kopf und Fußzeile anlegen. Hab es mit der Standardvariante probiert, aber die hat zu wenig Spalten (brauche für Kopfzeile 4 Spalten unterschiedlich breit und für Fußzeile 6 Spalten unterschiedlich breit). Ich wollte es erst direkt in einer Exceltabelle erstellen, aber ich habe dann gemerkt, das das bicht geht, da ich erstens keine Spalten einfügen kann, sonst klappt dass mit der automatischen Zeilenanpassung nicht mehr, wenn ich Zellen verbinde und dann müsste ich es für jede Seite manuell machen, aber da ich nie genau weiß wo eine Seite aufhört und eine andere anfängt ist das schwierig. Kann ich es eventuell so machen, dass ich mir in einem anderen Tabellenblatt die Kopf und Fußzeile in der Tabelle erstelle und per Makro mir dann diese Tabelle als Kopf und Fußzeile für jede Seite anzeigen lasse.
Ich hoffe ihr könnt mir helfen.
Gruß Oblivion

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim wks As Worksheet, wksFuss As Worksheet, strFusstext As String Set wksFuss = Worksheets("TabelleKundF") 'Tabellenblatt mit Fusszeileninhalten Select Case ActiveSheet.Name Case "Tabelle1" 'Tabelle deren Fusstext dynamisch angepasst werden soll Set wks = ActiveSheet With wksFuss 'Schriftart und Font-Größe für Fusstext 'Hinweis als Schriftart keine Proportionalschrift verwenden, wenn die Spalten immer _ an der gleichen Position beginnen sollen. strFusstext = "&""Courier New,Standard""&8" 'Spalte 1 strFusstext = strFusstext & Fusstext(Text:=.Range("E2").Text, Laenge:=20, bolVor:=False) _ 'Spalte 2 strFusstext = strFusstext & Fusstext(Text:=.Range("F2").Text, Laenge:=15, bolVor:=False) _ 'Spalte 3 strFusstext = strFusstext & Fusstext(Text:=.Range("G2").Text, Laenge:=10, bolVor:=False) _ 'Spalte 4 strFusstext = strFusstext & Fusstext(Text:=.Range("H2").Text, Laenge:=10, bolVor:=False) _ 'Spalte 5 strFusstext = strFusstext & Fusstext(Text:=.Range("I2").Text, Laenge:=20, bolVor:=False) _ 'Spalte 6 strFusstext = strFusstext & Fusstext(Text:=.Range("J2").Text, Laenge:=16, bolVor:=True) End With With wks .PageSetup.LeftFooter = strFusstext End With Case Else 'do nothing End Select End Sub Private Function Fusstext(Text As String, Laenge As Long, bolVor As Boolean) As String 'generiert einen Text fester Länge, wobei ggf. vor oder hinter dem Text Leerzeichen _ eingefügt werden If Len(Text) > Laenge Then Fusstext = Left(Text, Laenge) Else If bolVor = True Then 'Leerzeichen vor dem Text auffüllen Fusstext = Space(Laenge - Len(Text)) & Text Else 'Leerzeichen hinter dem Text auffüllen Fusstext = Text & Space(Laenge - Len(Text)) End If End If End Function

Hallo Oblivion,
der Spaltenaufbau des Fusstextes wird dadurch ereicht, dass im Code die Texte aus der Tabelle mit Leerzeichen aufgefüllt werden.
Der gesamte Text wird dann vom Makro in das linke Fusszeilen feld eingetragen. Man muss jedoch darauf achten, dass der Fusstext pro Feld max. 255 Zeichen lang ist. (war zumindest in den älteren Excelversionen so.
Den Text für die Kopfzeile kannst du natürlich in ähnlicher Weise zusammen bauen und in den Header des Blattes einfügen.
Die BeforePrint-Prozedure schaut dann beispielhaft wie folgt aus.
Gruß
Franz


Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wks As Worksheet, wksFuss As Worksheet
Dim strKopftext As String, strFusstext As String
Set wksFuss = Worksheets("TabelleKundF") 'Tabellenblatt mit Kopf-/Fusszeileninhalten
Select Case ActiveSheet.Name
Case "Tabelle1" 'Tabelle deren Fusstext dynamisch angepasst werden soll
Set wks = ActiveSheet
With wksFuss
'Schriftart und Font-Größe für Fusstext
'Hinweis als Schriftart keine Proportionalschrift verwenden, wenn die Spalten immer _
an der gleichen Position beginnen sollen.
strFusstext = "&""Courier New,Standard""&8"
'Spalte 1
strFusstext = strFusstext & Fusstext(Text:=.Range("E2").Text, Laenge:=20, bolVor:=False) _
'Spalte 2
strFusstext = strFusstext & Fusstext(Text:=.Range("F2").Text, Laenge:=15, bolVor:=False) _
'Spalte 3
strFusstext = strFusstext & Fusstext(Text:=.Range("G2").Text, Laenge:=10, bolVor:=False) _
'Spalte 4
strFusstext = strFusstext & Fusstext(Text:=.Range("H2").Text, Laenge:=10, bolVor:=False) _
'Spalte 5
strFusstext = strFusstext & Fusstext(Text:=.Range("I2").Text, Laenge:=20, bolVor:=False) _
'Spalte 6
strFusstext = strFusstext & Fusstext(Text:=.Range("J2").Text, Laenge:=16, bolVor:=True)
'Schriftart und Font-Größe für Kopftext
strKopftext = "&""Courier New,Standard""&8"
'Spalte 1
strKopftext = strKopftext & Fusstext(Text:=.Range("A2").Text, Laenge:=25, bolVor:=False) _
'Spalte 2
strKopftext = strKopftext & Fusstext(Text:=.Range("B2").Text, Laenge:=15, bolVor:=False) _
'Spalte 3
strKopftext = strKopftext & Fusstext(Text:=.Range("C2").Text, Laenge:=26, bolVor:=False) _
'Spalte 4
strKopftext = strKopftext & Fusstext(Text:=.Range("D2").Text, Laenge:=15, bolVor:=True)
End With
With wks
.PageSetup.LeftFooter = strFusstext
.PageSetup.LeftHeader = strKopftext
End With
Case Else
'do nothing
End Select
End Sub

Private Function Fusstext(Text As String, Laenge As Long, bolVor As Boolean) As String 'generiert einen Text fester Länge, wobei ggf. vor oder hinter dem Text Leerzeichen _ eingefügt werden If Len(Text) > Laenge Then Fusstext = Left(Text, Laenge) Else If bolVor = True Then 'Leerzeichen vor dem Text auffüllen Fusstext = Space(Laenge - Len(Text)) & Text Else 'Leerzeichen hinter dem Text auffüllen Fusstext = Text & Space(Laenge - Len(Text)) End If End If End Function

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread