Makro Zeilenhöhe verbundene Zellen
25.09.2024 08:21:01
Lubli
ich nutze schon seit langer Zeit ein Makro, dass mir bei verbundenen Zellen automatisch die Zeilenhöhe an den Textinhalt anpasst.
Nun ist es seit kurzem so, dass die angepasste Zeilenhöhe viel zu groß ist. Es entstehen sozusagen vor und nach dem eingefügten Text "Leerzeilen".
Dadurch muss ich, nachdem ich das Makro angewendet habe, die Zeilen trotzdem händisch anpassen. Das ist ja nicht Sinn und Zweck der Sache.
Kann mir jemand helfen, und das Makro überprüfen? Es wäre für meine Anwendung wichtig, dass keine "Leerzeilen" in einer Zelle vorhanden sind.
Ich danke euch für eure Hilfe schon einmal im Vorraus.
Liebe Grüße
Lisa
Meine Beispieldatei:
https://www.herber.de/bbs/user/172381.xlsm
Und mein Code:
Public Sub Zeilenhoehe()
Call AutoFitMergedCells(Range("d7:h7"))
Call AutoFitMergedCells(Range("d8:h8"))
Call AutoFitMergedCells(Range("d9:h9"))
Call AutoFitMergedCells(Range("d10:h10"))
Call AutoFitMergedCells(Range("d11:h11"))
Call AutoFitMergedCells(Range("d12:h12"))
Call AutoFitMergedCells(Range("d13:h13"))
Call AutoFitMergedCells(Range("d14:h14"))
Call AutoFitMergedCells(Range("d15:h15"))
Call AutoFitMergedCells(Range("d16:h16"))
Call AutoFitMergedCells(Range("d17:h17"))
Call AutoFitMergedCells(Range("d18:h18"))
Call AutoFitMergedCells(Range("d19:h19"))
Call AutoFitMergedCells(Range("d20:h20"))
Call AutoFitMergedCells(Range("d21:h21"))
Call AutoFitMergedCells(Range("d22:h22"))
Call AutoFitMergedCells(Range("d23:h23"))
Call AutoFitMergedCells(Range("d24:h24"))
Call AutoFitMergedCells(Range("d25:h25"))
Call AutoFitMergedCells(Range("d26:h26"))
End Sub
Public Sub AutoFitMergedCells(oRange As Range)
Dim tHeight As Integer
Dim iPtr As Integer
Dim oldWidth As Single
Dim oldZZWidth As Single
Dim newWidth As Single
Dim newHeight As Single
With Sheets("Tabelle2")
oldWidth = 0
For iPtr = 1 To oRange.Columns.Count
oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
Next iPtr
oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
oRange.MergeCells = False
newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
oldZZWidth = .Range("ZZ1").ColumnWidth
.Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
.Range("ZZ1").WrapText = True
.Columns("ZZ").ColumnWidth = oldWidth
.Rows("1").EntireRow.AutoFit
newHeight = .Rows("1").RowHeight / oRange.Rows.Count
.Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
oRange.MergeCells = True
oRange.WrapText = True
.Range("ZZ1").ClearContents
.Range("ZZ1").ColumnWidth = oldZZWidth
End With
End SubAnzeige