VBA Code " Zeilenhöhe bei Verb. Zellen Funktioniert fasst"
01.11.2023 23:08:01
polat
ich hatte in einem anderen Beitrag um ein Code gebeten.
Jetzt hab ich zwar ein Code von jemand anderem bekommen der nicht in einem Forum ist. Ich kann geradediese Person nicht erreichen kann.
Doch leider Funktioniert dieser Code nicht ganz wie ich es möchte.
Ich habe in einer Mappe in Reihe 43 verbundene Spalten ( C:J , L:S , U:AB). In diese Zellen z.b C:J ( Spalte hat eine Höhe von 64) schreibe ich 5 Sätze ( jeder Satz besteht aus 72 Zeichen) erhöht sich die Höhe der Zelle von 64 auf 88. Lösche ich diese 5 Sätze hat die Zelle wieder die höhe von 64.
Soweit so gut. Doch wenn ich weiter schreibe also Satz nr 6 Satz nr 7 und so weiter bleibt die Höhe bei 88 und erhöht sich nicht automatisch.
Kann mir jemand helfen diesen Code so Umzuschreiben das je mehr ich eingebe ( es könnten auch mal viel weniger wie 72 Zeichen sein) die Höhe sich anpasst und wenn ich einen Satz lösche es sich wieder anpasst. Ich danke euch jetzt schon für eure Hilfe.
Hier ist der Code. Beispiel Datei hänge ich an.
https://www.herber.de/bbs/user/163970.xlsm
Gruß Polat
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Union(Range("C43:J43"), Range("L43:S43"), Range("U43:AB43"))
If Not Intersect(Target, rng) Is Nothing Then
' Überprüfen, ob der Bereich nicht leer ist
If WorksheetFunction.CountA(rng) > 0 Then
' Bestimmen Sie die Anzahl der geschriebenen Zeilen
Dim lineCount As Integer
lineCount = 0
Dim cell As Range
For Each cell In rng
Dim lines As Integer
lines = Len(cell.Value) - Len(Replace(cell.Value, vbCrLf, "")) + 1
lineCount = lineCount + lines
Next cell
' Einblenden der Zeile, falls ausgeblendet
Rows("43:43").Hidden = False
' Passen Sie die Zeilenhöhe entsprechend an
Rows("43:43").EntireRow.AutoFit
If Rows("43:43").RowHeight 150 Then
Rows("43:43").RowHeight = 64 + (lineCount * (136 / 136)) ' Anpassen der Höhe basierend auf der Anzahl der geschriebenen Zeilen
End If
Else
' Wenn der Bereich leer ist, stellen Sie die ursprüngliche Zeilenhöhe wieder her
Rows("43:43").RowHeight = 64
End If
End If
End Sub