MergeCells optimale Zeilenhöhe geht (teilweise)
09.11.2017 11:11:09
Haika
Folgendes Makro funktioniert (VBA 7.0).
Einen zusammengefügten Bereich aus 4 Zellen übereinander wähle ich aus,
das Makro paßt dann die Höhe jener Zellen gleichmäßig an.
---------------------------------------------------------------------
ZeilenHöheAnpassen()
'
Dim i As Integer
Dim Summe As Integer
For i = 1 To Len(ActiveCell)
If Mid(ActiveCell, i, 1) = Chr(10) Then Summe = Summe + 1
Next i
'folgender Befehl lautet, einzelne Zeilenhöhe =
'Zeilenanzahl+1 * Schriftgröße + Absatz (Maßeinheit Punkte)
'dividiert durch Anzahl verbundener Zellen (immer gleich viele in selber Spalte)
Range(ActiveCell, ActiveCell.Rows).Select
Selection.RowHeight = (Summe + 1) * (9 + 4) / 4
End Sub
---------------------------------------------------------------------
Funktioniert auch einwandfrei. Nur möchte ich nicht jeden verbundenen Bereich manuell wählen. Ich möchte das kleine Sub in einer anderen Sub laufen lassen, etwa so:
---------------------------------------------------------------------
Dim Zelle As Range
Range("W10:W" & Rows.Count).Select
For Each Zelle In Selection
If Zelle.MergeCells = True Then ZeilenHöheAnpassen
Next Zelle
---------------------------------------------------------------------
Leider ohne Erfolg.
Nun benötige ich Eure Hilfe. Vielen Dank.
Gruß