Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellgröße (verb. Zelle) anpassen mit VBA

Zellgröße (verb. Zelle) anpassen mit VBA
Tom
Hallo,
ja ich kenne das Problem mit verbundenen Zellen und der automatischen Zellgrößenanpassung.
Ich habe das Thema bisher immer durch Vermeidung v. verb. Zellen gelöst.
Jetzt komme ich aber auf Grund von speziellen Formatierungen und an mich gerichtete Anforderungen nicht ohne aus.
Gibt es denn eigentlich eine Möglichkeit bei zwei mit einander verbundenen Zellen die an die je nach Inhalt benötigte Höhe anzupassen?
Also die Breite müsste fest bleiben, die Höhe ist der Punkt, welcher sich an den Inhalt anpassen müsste.
Jemand eine Idee?
Der Tom

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellgröße (verb. Zelle) anpassen mit VBA
24.09.2009 13:53:16
JogyB
Hi.
Da hier funktioniert meistens, aber leider nicht immer. Ab und an ist es eine Zeile zu viel.
' 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
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)
' 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
Gruss, Jogy
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige