Grüezi Lucas
heute bringt mich mal wieder Excel zum Verzweifeln. Ich habe
eine Art Formular erstellt, dass von weniger erfahrenen
Benutzern ausgefüllt werden soll. Dabei gibt es einige
auszufüllende Zellen, die teilweise mit längeren texten
gefüllt werden. Daher habe ich in diesen Zellen den
Zeilenumbruch aktiviert. Geht der Text nun über die Breite der
zelle hinaus, wird die Zelle automatisch nach unten hin
vergrößert und in der zweiten zeile der Zelle weiter
geschrieben.
Bis hierhin ist IMO alles OK…
Soweit funktioniert alles super. Aber leider habe ich auch ein
paar verbundende zellen,
…aber das hier ist nun wirklich nicht gut.
Verbundene Zelle machen in der Regel mehr Probleme als sie der Optik Nutzen bringen.
Verzichte daher darauf, Zellen zu verbinden!
in die längere Texte eingetragen
werden sollen. Diese verbundenden zellen verhalten sich leider
nicht wie normale Zellen. Zwar habe ich den zeilenumbruch
aktiviert, doch wird die Zelle nicht automatisch vegrößert.
Der Text, der in der zweiten zeile landet ist dann einfach
nicht sichtbar.
Gibt es eine Möglichkeit, eine von mir übersehen Einstellung,
meinetwegen auch einen VBA-Code oder ähnliches, was dieses
Problem löst?
Dabei sei die Möglichkeit, nur nicht verbundene Zellen zu
verwenden, ausgeschlossen. Das hilft mir nicht.
Diese Prämisse solltest Du nochmals ernsthaft überdenken.
…aber wenn Du es nicht anders möchtest
, dann teste mal die folgenden VBA-Zeilen:
Function ZeilenHoeheVerbundeneZellen(ByVal rngZelle As Range)
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
'von Hans Herber / angepasst von Thomas Ramel ([email protected])
'Aufrufen per Übergabeparameter mit der folgenden Zeile:
’
'Sub test()
'ZeilenhoeheVerbundeneZellen (ActiveSheet.Range(„A1“))
'End Sub
’
Dim CurrentRowHeight As Single
Dim MergedCellRgWidth As Single
Dim CurrCell As Range
Dim CellWidth As Single
Dim PossNewRowHeight As Single
Dim iX As Integer
If IsEmpty(rngZelle) Then
Set rngZelle = ActiveCell
End If
If rngZelle.MergeCells Then
With rngZelle.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
CellWidth = rngZelle.ColumnWidth
For Each CurrCell In rngZelle.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
iX = iX + 1
Next
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = CellWidth
.MergeCells = True
'.RowHeight = PossNewRowHeight
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Function
Mit freundlichen Grüssen
Thomas Ramel