Zellenhöhe bei verbundenen Zellen (VBA Code?)

Forumthread: Zellenhöhe bei verbundenen Zellen (VBA Code?)

Micha

Hallo liebe Spezialisten,
ich habe folgendes Problem und würde mich über einen VBA-Code riesig freuen.
In der Tabelle1 sind in dem Bereich B53:AI63 die Zellen verbunden.
Der in diesem Bereich von anderen Usern eingegebene Text ist unterschiedlich lang.
Der Zeilenumbruch funktioniert problemlos. Wenn jedoch der eingegebene Text zu lang ist, wird der Text in der Ansicht unten abgeschnitten. Ich möchte gerne das sich die Zellenhöhe des Bereichs von jetzt 15,5 auf die benötigte Zellenhöhe anpasst.
Freue mich auf ein Feedback.
Vielen Dank und Gruß
Micha

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

AW: Zellenhöhe bei verbundenen Zellen (VBA Code?)

JogyB

AW: Zellenhöhe bei verbundenen Zellen (VBA Code?)

17.09.2009 13:18:38

JogyB

Hi.
Probier mal den Code:

' Autofit von verbundenen Zellen
Public Sub instantFitHeight()
Dim tempWidth As Double
Dim zeLLe As Range
Dim totalWidth As Double
Dim totalPxWidth As Double
Dim myCells As Range
Dim tempHeight As Double
Dim oldHeight As Double
'    Dim adjWidth As Double
'    Dim i As Long
Application.ScreenUpdating = False
On Error GoTo fitErr
Set myCells = Selection
With myCells
' Macht nur etwas für einzelne Zeile, wenn die Zellen verbunden sind und wenn der  _
Zeilenumbruch aktiv ist
If .Rows.Count = 1 And .MergeCells = True And (.WrapText = True Or IsNull(.WrapText))  _
Then
' Speichert alte Zeilehöhe zwischen
oldHeight = .RowHeight
' Speichert die Breite der ersten Zelle zwischen
tempWidth = .Cells(1).ColumnWidth
' Berechnet die Gesamtbreite der verbundenen Zellen
For Each zeLLe In myCells
totalWidth = zeLLe.ColumnWidth + totalWidth
totalPxWidth = zeLLe.Width + totalPxWidth
Next
' Löst den Verbund auf
.MergeCells = False
' weist der ersten Zelle (dort steht der Text) die Gesamtbreite zu
.Cells(1).ColumnWidth = totalWidth
' Breitenkorrektur auf Breite in Pixel
.Cells(1).ColumnWidth = _
.Cells(1).ColumnWidth + (.Cells(1).ColumnWidth - .Cells(2).ColumnWidth) / _
(.Cells(1).Width - .Cells(2).Width) * (totalPxWidth - .Cells(1).Width)
'    ' Breitenkorrektur, bis Breite in Pixel stimmt
'            adjWidth = .Cells(1).ColumnWidth
'            i = 1
'            While .Cells(1).Width  totalPxWidth
'                .Cells(1).ColumnWidth = adjWidth + i * 0.01
'                i = i + 1
'            Wend
' Führt Autofit durch
.EntireRow.AutoFit
' Speichert die Höhe zwischen
tempHeight = .RowHeight
' Weist der ersten zelle wieder die alte Breite zu
.Cells(1).ColumnWidth = tempWidth
' Verbindet die Zellen wieder
.MergeCells = True
' Weist Höhe zu (geht beim Verbinden wieder verloren)
.RowHeight = tempHeight + 0.75
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
fitErr:
On Error Resume Next
' Weist der ersten zelle wieder die alte Breite zu
myCells.Cells(1).ColumnWidth = tempWidth
' Verbindet die Zellen wieder
myCells.MergeCells = True
' Weist alte Höhe wieder zu
myCells.RowHeight = oldHeight
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Du mußt die Zelle markieren und den Code ausführen (über Shortcut oder Button). Ist aber nicht perfekt, ab und an macht er eine Zeile zu viel.
Gruss, Jogy

Beliebteste Forumthreads (12 Monate)

Zellenhöhe bei verbundenen Zellen (VBA Code?)

Forumthread: Zellenhöhe bei verbundenen Zellen (VBA Code?)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread