Zeilehoehe automatisch anpassen bei verbundenen Z
05.04.2006 18:14:44
Friedemann
Ich muss die Frage nochmals wiederholen:
Ich möchte meine Zeilenhöhe von verbundenen Zellen automatisch anpassen.
Ich habe folgendes Makro gefunden welches auch sehr gut funktioniert. Ich möchte es aber wie folgt abändern:
1. Das Makro soll laufen wenn das Arbeitsblatt aufgerufen wird oder als Module über das Drücken einer Taste im Arbeitsblatt.
2. Das Makro soll die Zeilenhöhe für die Zellen e27:k112 (e-k ist verbunden, also Zeilen 27 bis 112) anpassen.
Mit >Range("e27:k112") Kann mir da jemand helfen?
Hier das Makro wie es zur Zeit ist:
Sub autofitXLMergedCells()
'Passt Zeilenhöhe an den Text innerhalb von verbundenen Zellen im selektierten Bereich an
'(Die Autofit-Methode des Excel-Range-Objektes funktioniert für verbundene Zellen nicht)
On Error GoTo Err_autofitXLMergedCells
Dim lo_CurRange As Excel.Range
Dim lsg_SumCellWidths As Single
Dim lsg_OriginalWidthFirstCol As Single
Dim lsg_NewRowHeight As Single
Dim li_MergedCellsCount As Integer
With Selection
If .MergeCells Then
If .Rows.Count = 1 And .WrapText = True Then
lsg_OriginalWidthFirstCol = .Cells(, 1).ColumnWidth
'Einzelzellbreiten und Breiten der Gitterlinien summieren
For Each lo_CurRange In Selection
lsg_SumCellWidths = lo_CurRange.ColumnWidth + lsg_SumCellWidths
li_MergedCellsCount = li_MergedCellsCount + 1
Next
lsg_SumCellWidths = lsg_SumCellWidths + (li_MergedCellsCount - 1) * 0.71
'Verbindung der Zellen aufheben, erste (datentragende) Zelle auf Gesamtbreite ausdehnen und
'Höhe anpassen über Standardmethode
.MergeCells = False
.Cells(1).ColumnWidth = lsg_SumCellWidths
.EntireRow.AutoFit
'Resultierende Zeilenhöhe merken, erste Zelle zurücksetzen, Verbindung wiederherstellen, Höhe anpassen
lsg_NewRowHeight = .RowHeight + 15
.Cells(1).ColumnWidth = lsg_OriginalWidthFirstCol
.MergeCells = True
.RowHeight = lsg_NewRowHeight
End If
End If
End With
Exit Sub
'Nur für's Debuggen
Resume
Err_autofitXLMergedCells:
MsgBox Err.Number & ": " & Err.Description
End Sub
Vielen Dank an Alle
Friedemann