Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1576to1580
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Anpassung Zeilenhöhe für mehrere Zeilen

Anpassung Zeilenhöhe für mehrere Zeilen
06.09.2017 09:22:44
Lilly
Hallo,
ich habe mir mithilfe des Codes aus einem anderen Beitrag hier die Funktion gebastelt bei Eingabe in eine Zelle (hier D24) die Zeilenhöhe an die Menge des Textes anzupassen. Zelle D24 ist eine verbundene Zelle (D bis I, geht leider nicht anders).
Nun brauche ich eure Hilfe: wie kann ich den Code so anpassen, dass genauso bei Eingabe in Zelle D25 (auch verbunden) die Zeilenhöhe in Zeile 25 angepasst wird (und ebenso in Zeile 26, 28, 36 und 44).
Die Scrollarea habe ich festgesetzt, da er sonst bei drücken der Enter-Taste immer in die nächste Zeile gesprungen ist und dann diese statt die eigentliche Zeile angepasst hat.
Hier mein Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("D24") Then
Call Tabelle1.AutoFitMergedCellRowHeight
End If
End Sub
Sub AutoFitMergedCellRowHeight()
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Tabelle1.ScrollArea = "D24"
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
Tabelle1.ScrollArea = ""
End Sub
Das ganze funktioniert auch mit diesem Anfang:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Set KeyCells = Range("D24")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call Tabelle1.AutoFitMergedCellRowHeight
End If
End Sub
Vielleicht könnt ihr mir ja auch noch sagen, welchen Sub Worksheet_Change ich bevorzugt benutzen sollte.
Liebe Grüße
Lilly

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anpassung Zeilenhöhe für mehrere Zeilen
06.09.2017 09:53:24
Werner
Hallo Lilly,
teste mal:
Option Explicit
Public Zielzelle As Range
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column  4 Then Exit Sub
Select Case Target.Row
Case 24, 25, 26, 28, 36, 44
Set Zielzelle = Target
Call Tabelle1.AutoFitMergedCellRowHeight
Case Else
End Select
End Sub
Sub AutoFitMergedCellRowHeight()
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Tabelle1.ScrollArea = Zielzelle.Address
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
Tabelle1.ScrollArea = ""
End Sub
Gruß Werner
Anzeige
AW: Anpassung Zeilenhöhe für mehrere Zeilen
06.09.2017 12:05:09
Lilly
Hallo Werner,
danke für deine schnelle Antwort. Das ganze funktioniert echt super.
Gerne u.Danke für die Rückmeldung. o.w.T.
06.09.2017 12:27:52
Werner

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige