Dieses Makro formatiert Tabellenspalten auf die optimale Breite, bezogen auf den Inhalt. Gleichzeitig werden die Überschriften in fetter Schrift (bold) dargestellt. Wenn die Überschrift breiter ist, als die optimale Spaltenbreite, wird der Text senkrecht gestellt.
Unformatierte Tabelle
Formatierte Tabelle
Hier das Makro zum Kopieren:
Option Explicit
Sub Format()
' Formatiert Überschriften und Tabellenspalten
' geschrieben von Klaus-Dieter Oppermann
' November 2002
' http://www.klaus-dieter-2000.de
Dim spa$, br%(10), bru%(10) ' Variablen deklarieren
Dim sp%, z% ' Variablen deklarieren
' Tabellengröße ermitteln
sp = Rows(1).End(xlToRight).Column ' Letzte Spalte (numerischer Wert)
spa = Chr(sp + 64) ' Letzte Spalte (alphanumerischer Wert)
z = Range("A1").End(xlDown).Row ' Letzte Zeile (numerischer Wert)
' Überschriften formatieren
Rows("1:1").Font.Bold = True ' Fette Schrift
Range("A2", spa & z).Columns.AutoFit ' Optimale Breite nach Tabelleninhalten einstellen
' Spaltenbreite in Variable einlesen (Überschriften)
For r = 1 To sp ' Start For-To-Next Schleife
br(r) = Cells(2, r).ColumnWidth ' Spaltenbreite
Next r ' Schleifenzähler + 1
' Spaltenbreite in Variable einlesen (Tabelle)
Range("A1", spa & 1).Columns.AutoFit ' Optimale Breite nach Überschriften einstellen
For r = 1 To sp ' Start For-To-Next Schleife
bru(r) = Cells(1, r).ColumnWidth ' Spaltenbreite
Next r ' Schleifenzähler + 1
' Tabelle formatieren
For u = 1 To sp ' Start For-To-Next Schleife
If bru(u) > br(u) Then ' Wenn Überschrift breiter als Spalteninhalte ...
Cells(1, u).Orientation = 90 ' ... dann Text senkrecht
Cells(1, u).HorizontalAlignment = xlLeft ' ... Text linksbündig
End If ' Ende wenn
Next u ' Schleifenzähler + 1
Range("A1", spa & z).Columns.AutoFit ' Optimale Breite für gesamte Tabelle
End Sub ' Ende des Makros
Code eingefügt mit: Excel Code Jeanie |