Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Zellhöhe automatisch anpassen





Frage

Hallo Freunde Ich habe in einer Tabelle innerhalb einer Zeile 4 Zellen verbunden und unter Formatieren/Ausrichtung den Zeilenumbruch gesetzt. Nun möchte ich, dass sich die Zellenhöhe automatisch auf den Gesamttext des Schriftinhaltes anpasst. Gibt's da was? Grüsse Rickie

Antwort 1 von fedjo

Hallo Rickie,
mit VBA git es schon eine Möglichkeit.

Welche Zellen sind verbunden?
Zitat:
Tabelle innerhalb einer Zeile 4 Zellen



Gruß
fedjo

Antwort 2 von Rickie

Hallo Fedjo

In meiner Tabelle sind sieben Zellen verbunden A - G

Würde mich freuen, wenn du mir eine entsprechende VBA-Anweisung hättest.

Gruss
Rickie

Antwort 3 von fedjo

Hallo Rickie,
in das Codefenster der Tabelle wo die Zellenhöhe automatisch verändert werden soll:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1").Rows.AutoFit
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If Range("A1").MergeCells Then

With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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 = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

Bei der Aktiven Zelle (A1) wird dann der ganze Text angezeigt, ansonst nur die normale Zeilenhöhe.


Gruß
fedjo

Antwort 4 von Rickie

Hallo Fedjo

Besten Dank für das feature - klappt tatsächlich.
Allerdings habe ich noch zwei Fragen dazu;

- im Moment bezieht sich das Makro nur auf eine Zelle.
Ich habe jedoch rund 2000 Zellen (Zeilen) die ich so ändern möchte. Gibt es dafür evtl einen Rangebefehl oder kann ich, da sich diese Zellen alle in der Spalte A befinden, die Spalte A als Range eingeben?
- zweitens passt sich die Zeile nur dann an den gefüllten Zelleninhalt an, wenn ich Sie aktiv (markiert) habe. Könnte man diese nicht konstant angepasst lassen?

Besten Dank im voraus für deine (eure) Mühe

Rickie

Antwort 5 von fedjo

Hallo Rickie,
habe umgestellt auf Aktive Zelle, durch rechts Klick kann die Zelle zurückgesetzt werden.

Gruß
fedjo

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Selection.Rows.AutoFit
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer

If ActiveCell.MergeCells Then

With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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 = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

Antwort 6 von Rickie

Hi Fedji

Perfekt - genau das brauche ich!!!

Besten Dank für die Unterstützung

Rickie