makro, das zeilenhöhe anpasst

[klaus k?nig]

hallo ng,

wie lautet ein makro, das für einen range-bereich die zeilenhöhe so
anpasst, dass der text im ausdruck voll kommt, nicht abgedeckt bwz in
einer nicht zu großen zelle auftaucht?

freue mich auf eine antwort.

klaus

[Björn Stern]

Hi Klaus,


probiere es mal hiermit:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Anpassen
End Sub

Sub Anpassen()
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
End Sub


Gruß vom Björn

Post by klaus k?nig
hallo ng,
wie lautet ein makro, das für einen range-bereich die zeilenhöhe so
anpasst, dass der text im ausdruck voll kommt, nicht abgedeckt bwz in
einer nicht zu großen zelle auftaucht?
freue mich auf eine antwort.
klaus

[Jörg Eisenträger]

Post by Björn Stern
Cells.EntireRow.AutoFit

Kleine Anmerkung: Das klappt leider nicht mit verbundenen Zellen.
(Jedenfalls hatte es bei mir nicht geholfen.)

Gruß
Jörg

[Eberhard Funke]

Hallo Klaus,

Post by klaus k?nig
hallo ng,
wie lautet ein makro, das für einen range-bereich die zeilenhöhe so
anpasst, dass der text im ausdruck voll kommt, nicht abgedeckt bwz in
einer nicht zu großen zelle auftaucht?
freue mich auf eine antwort.
klaus

wenn Du das über die ZeilenHÖHE machen willst, dann geht das nur über
Zeilenumbruch

Sub Anpassen()
Selection.WrapText = True
End Sub

Wenn Dir die Zelle zu groß ist, könntest Du zusätzlich noch die
Schrift verkleinern, z. B, auf 8:

Sub Anpassen2()
With Selection
.Font.Size = 8
.WrapText = True
End With
End Sub
--
Gruß Eberhard
XL 2000

[Olaf Gerecke]

Hallo Klaus,

mit verbundenen Zellen ist das ein bisschen schwieriger;-)
Ich hab Dir hier mal eine Prozedur geschrieben und Kommentiert (sowie auch
getestet), mit der es geht.
Achtung: So funktioniert es nur, solange Du pro Zeile nur einen Zellvberbund
mit Zeilenumbruch hast. Wenn es mehr sind, musst Du in der aufrufenden
Prozedur dafür sorgen, dass auch der höchste Range "gewinnt".

Sub ZeilenHoehe(Target As Range)

Dim ActiveCellWidth, tmpCellWidth, PossNewRowHeight, MergedCellRgWidth
As Single
Dim iX, iY, iZ As Integer
Dim CurrCell As Range

On Error Resume Next

'Wenn der Zellverbund nicht leer ist
If Not Trim(Target.Cells(1)) = "" Then
'nur, wenn es sich um verbundene Zellen handelt
If Target.MergeCells Then
With Target.MergeArea
'nur, wenn einzeilig und Zeilenumbruch eingeschaltet
If .Rows.Count = 1 And .WrapText = True Then
'Schleife über alle Zellen zur Berechnung der Gesamtbreite
For Each CurrCell In Target.MergeArea
tmpCellWidth = CurrCell.ColumnWidth
MergedCellRgWidth = tmpCellWidth + MergedCellRgWidth
iX = iX + 1
Next
'die Anzahl Spalten minus Eins multipliziert mit 0,5
aufschlagen
'0,5 ist die Standardbreite der Rahmenlinie zwischen den
Spalten
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.5
'Zellverbund auflösen
.MergeCells = False
'erste Spaltenbreite merken
ActiveCellWidth = .Cells(1).ColumnWidth
'Gesamtbreite der ersten Spalte zuweisen
.Cells(1).ColumnWidth = MergedCellRgWidth
'jetzt automatische Zeilenhöhenanpassung ausführen
.EntireRow.AutoFit
'neue Höhe merken
PossNewRowHeight = .RowHeight
'leichter Aufschlag in der Höhe bei anderen Fonts als
Arial,
'damit die unterste Zeile nicht abgeschnitten wird
If Target.Font.Name <> "Arial" Then PossNewRowHeight =
.RowHeight * 1.05
'erste Spalte auf alte Breite zurück
.Cells(1).ColumnWidth = ActiveCellWidth
'Zellverbund wiederherstellen
.MergeCells = True
'neue Zeilenhöhe dem Zellverbund zuweisen
.RowHeight = PossNewRowHeight
End If
End With
Else
'einzelne Zelle
Target.EntireRow.AutoFit
End If
Else 'Zelle ist Leer
If Target.WrapText Then
Target.EntireRow.AutoFit
End If
End If
End Sub