Anzahl der Spalten erkennen
11.03.2004 11:45:04
Armin
ich habe folgenden Beitrag ins Excel Center gestellt. Aber irgendwie kann mir keiner helfen und ich müsste mit der Sache ziemlich dringend etwas arbeiten.
Der liebe Maxe hat mir den unten stehenden Code geschrieben. Dieser Code erstellt eine Kopfzeile für Tabellen. Ich brauche diese Kopfzeile sehr häufig. Das Problem ist aber, dass die Tabellen häufig unterschiedlich viele Spalten haben. Das Makro müsste also so abgeändert werden, dass es selbst erkennt, wieviel gefüllte Spalten die Tabelle hat um die richtige Breite für die Kopfzeile zu bestimmen. Kann mir da jemand helfen?
Danke im Voraus!
Gruß
Armin
Sub Übersicht()
ActiveCell.Range("A1:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection.Font
.Name = "Futura Bk BT"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "ÜBERSICHT KONZERNFÜHRUNG"
ActiveCell.Offset(2, 0).Range("A1").Select
End Sub