EntireRow.AutoFit bei merged cells

Hallo Experten,

ich hab mal wieder *sigh* ein kleines Excelproblem…

Und zwar hab ich eine Reihe von Zellen, die verbunden sind…
Die sind deswegen verbunden, weil eine Formel da einen relativ langen Text ausgibt, der sich je nach Inhalt einer anderen Zelle ändert…

Nun hab ich das Problem, dass die Zeile, in der diese Zelle ist mit EntireRow.AutoFit nicht an den Text angepasst wird… Das funktionierte zwar noch, als die Zellen nicht verbunden waren, aber dadurch wurde die Zeile sehr hoch, was auf dem ausdruck scheisse aussah…
Bei der unverbundenen Zelle die grösse zu ändern geht aber nicht, weil sonst andere Zellen nach rechts rutschen und damit aus dem Druckbereich…

Gibt es eine Möglichkeit die Zellen trotzdem auf autofit einzustellen, so dass man den ganzen Text lesen kann?

vielen Dank
Munich

VBA-Autofit für Text über mehrere Spalten

Nun hab ich das Problem, dass die Zeile, in der diese Zelle
ist mit EntireRow.AutoFit nicht an den Text angepasst wird…
Das funktionierte zwar noch, als die Zellen nicht verbunden
waren, aber dadurch wurde die Zeile sehr hoch, was auf dem
ausdruck scheisse aussah…
Bei der unverbundenen Zelle die grösse zu ändern geht aber
nicht, weil sonst andere Zellen nach rechts rutschen und damit
aus dem Druckbereich…

Hi Munich,
du musst bei dir umstellen, sodass die Formel, die als Ergebnis den langen Text anzeigt, auf Tabelle2 in Zelle A1 steht.
Dann erscheint nach Aufruf der Sub der Text in Tabelle 1 in C5:F5 und die Spaltenbreite ist angepasst an die Textlänge.
Am besten den Sub-Code noch in ein Worksheet_Change-ERreignis einbinden, dann geht es automatisch.
Durch die Funktion die die Left-Werte in Width-Werte per Schleife umrechnet, ist das Makro nicht das schnellste, evtl. gibt es da eine direktere Umrechnung.
Gruß
Reinhard

Sub freak()
Application.ScreenUpdating = False
Set ZielBereich = Worksheets("Tabelle1").Range("C5:F5")
ZielBereich.ClearContents
With Worksheets("Tabelle2")
 .Columns(1).AutoFit
 .Range("A1").Copy
 Breite = .Range("B1").Left
End With
With Worksheets("Tabelle1")
 For Each Bild In .Shapes
 If Left(Bild.Name, 7) = "Picture" Then Bild.Delete
 Next Bild
 .Pictures.Paste(Link:=True).Select
 Selection.ShapeRange.Left = ZielBereich.Left
 Selection.ShapeRange.Top = ZielBereich.Top
 .Range("A1").Select
 ZielBereich.ColumnWidth = Punkte(Breite) / 4
End With
Application.CutCopyMode = False
Set ZielBereich = Nothing
Application.ScreenUpdating = True
End Sub

Function Punkte(ByVal B As Double)
With Worksheets("Tabelle2")
 .Range("B1").ColumnWidth = 0
 For n = 2 To 0 Step -1
 While .Range("C1").Left 

Danke und * dafür…
aber eigentlich sollte das ganze ja in der Zelle stehen…
kann man nicht vielleicht die Spaltenbreite ausmessen und so durchkalkulieren, wie hoch die Zelle sein muss, damit alles reinpasst und anschliessend die höhe anpassen?

Weil mit den Schaltflächen hab ich irgendwie auch ein Problem…
Ich komm zum Beispiel auch nicht dahinter, wie Du da die breite definierst von diesem Feld…

Generell versteh ich Deinen Code nicht, aber das liegt wohl daran, dass mir die Funktionen, die Du benutzt noch relativ unbekannt sind…

Autofit bei verbundenen Zellen (vereinfacht)

Und zwar hab ich eine Reihe von Zellen, die verbunden sind…
Die sind deswegen verbunden, weil eine Formel da einen relativ
langen Text ausgibt, der sich je nach Inhalt einer anderen
Zelle ändert…

Nun hab ich das Problem, dass die Zeile, in der diese Zelle
ist mit EntireRow.AutoFit nicht an den Text angepasst wird…
Das funktionierte zwar noch, als die Zellen nicht verbunden
waren, aber dadurch wurde die Zeile sehr hoch, was auf dem
ausdruck scheisse aussah…
Bei der unverbundenen Zelle die grösse zu ändern geht aber
nicht, weil sonst andere Zellen nach rechts rutschen und damit
aus dem Druckbereich…

Hi Munich,
ich habe den Code beträchtlich vereinfacht.
Alt+F11, Doppelklick auf Tabelle 2
Dort den nachfolgenden Code eingeben, Editor schliessen.
In Tabellenblatt 2 muss in Zelle A1 die Formel:
=Tabelle1!$C$5
stehen dann klappt es.

Private Sub Worksheet\_Calculate()
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
 If .Range("C5:F5").MergeCells = True Then .Range("C5:F5").MergeCells = False
 .Range("C5").EntireColumn.AutoFit
 .Range("C5:F5").ColumnWidth = .Range("C5").ColumnWidth / 4
 .Range("C5:F5").MergeCells = True
End With
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

Hallo Munich,

ich hab auch noch ein wenig in VBA gebastelt. Nachfolgendes Makro paßt die Höhe der Zeile mit den verbundenen Zellen an, wenn die Zellen angewählt werden. Die verbundenen Zellen müssen mit zeilenumbruch formatiert sein.
Natürlich kannst du das Makro auch in einen anderen Ablauf einbinden. In dem Fall muss in der 4. Zeile die Addresse für die Variable ‚Zelle‘ entsprechend festgelegt werden.
Es funktioniert gut für TT Arial-Fonts bis Größe 20 und fett oder normal. Auch TT Times Roman funktioniert gut. Für andere Fonts müssen die Werte in den CASE-Bedingungen entsprechend angepaßt werden.

 Private Sub Worksheet\_SelectionChange(ByVal Target As Excel.Range)
 If Target.Address = "$B$3:blush:D$3" Then 'Verbundener Zellbereich
'Zeilenhöhe wird entsprechend dem Text in de verbundenen Zellen angepaßt.
 Zelle = Left(Target.Address, 4) 'hier "$B$3"
 If Range(Zelle).WrapText = False Then
 MsgBox ("Zelle muß mit Zeilenumbruch formatiert sein!")
 Exit Sub
 End If
'Anzahl der verbundenen Spalten
 Range(Zelle).Columns.Select
 Spalten = Selection.Columns.Count 'Anzahl der verbundenen Spalten
'Korrektur Abstand Text - Zellrand
 Rand = 2 \* Spalten \* Range(Zelle).Font.Size / 32
' Breite der verbundenen Zelle
 Breite = Rand
 Spalte1 = Range(Zelle).Column
 For I = 1 To Spalten
 Breite = Breite + Cells(1, Spalte1 + I - 1).ColumnWidth
 Next
 Zeichen = Len(Range(Zelle).Value)
 Fett = Range(Zelle).Font.Bold
 Select Case Range(Zelle).Font.Size
' ZH =Zeilenhöhe
' FZB = Korrektur-Faktor für Zeichenbreite
' FB = Korrektur-Faktor für Fettschrift
' Die Faktoren FZB und FB gelten für Font TT Arial und passen in
' etwa auch für TT TimesRoman.
' FZB und FB wurden experimentell ermittelt aus einem Mustertext.
' Besteht der Text nur aus Großbuchstaben sind die Faktoren zu Groß
 Case 8
 ZH = 11.25: FZB = 1.385: FB = 0.889
 Case 9
 ZH = 12: FZB = 1.282: FB = 0.94
 Case 10
 ZH = 12.75: FZB = 1.154: FB = 0.933
 Case 11
 ZH = 15: FZB = 1.051: FB = 0.902
 Case 12
 ZH = 15.75: FZB = 0.974: FB = 0.921
 Case 13, 14
 ZH = 18.75: FZB = 0.769: FB = 0.933
 Case 15, 16
 ZH = 20.25: FZB = 0.718: FB = 0.929
 Case 17, 18
 ZH = 23.25: FZB = 0.641: FB = 0.92
 Case 19, 20
 ZH = 26.25: FZB = 0.564: FB = 0.909
 Case Else
 MsgBox ("Fontgröße liegt außerhalb Wertebereich von 8 bis 20")
 Exit Sub
 End Select
 If Fett = False Then FB = 1
 Range(Zelle).RowHeight = ZH \* Int(Zeichen / (Breite \* FZB \* FB) + 1)
 End If
End Sub\>/pre\>
Gruß
Franz

das funktioniert leider so noch immer nicht ganz :confused:

Mein Problem ist, dass die Zellen, aus denen die Werte kommen Zeilenumbrüche drin haben…
also quasi chr10 zeichen drin…
und damit kommen die Scripte bisher nicht klar…
beim einen wird zwar die spaltenbreite angepasst, aber das nutzt mir ja nichts, weil sonst das design der anderen Tabelle zerschossen wird :-/

Lediglich die Zeilenhöhe sollte sich anpassen…
aber vielleicht kann ich ja dieses chr(10) zeichen suchen und dadurch die anzahl der verwendeten Zeilen wenigstens ungefähr ausrechnen? Aber ich müsste dann noch den Platzbedingten Zeilenumbruch mitberücksichtigen… Naja - ein Ansatz ist es vielleicht…

Danke aber trotzdem - für die Mühen noch ein Sternchen :smile:

Lediglich die Zeilenhöhe sollte sich anpassen…
aber vielleicht kann ich ja dieses chr(10) zeichen suchen und
dadurch die anzahl der verwendeten Zeilen wenigstens ungefähr
ausrechnen? Aber ich müsste dann noch den Platzbedingten
Zeilenumbruch mitberücksichtigen… Naja - ein Ansatz ist es
vielleicht…

Hi Munich,
sorry, ging bisher von gleichbleibender Zeilenhöhe aus.
Also soll die Spaltenbreite konstant bleiben und die Zeilenhöhe solls sich automatisch anpassen?
Oder beides?
Sag mir doch um welchen Zellenbereich es sich handelt, dann kann ich das gleich richtig schreiben.
Gruß
Reinhard

Danke dafür
sieht recht komplex aus… mich in den Code einzulesen wird noch ne weile dauern zumal ich im Moment kaum dazu komme…

Allerdings hab ich auch hier das Problem, dass ein Zeilenwechsel Probleme macht aber solche eben in der Quelle vorkommen…
Aber vielleicht komm ich so der Sache ja schonmal näher…

Das Sternchen hast Du Dir aber trotzdem redlich verdient :wink:

Hi Munich,
sorry, ging bisher von gleichbleibender Zeilenhöhe aus.
Also soll die Spaltenbreite konstant bleiben und die
Zeilenhöhe solls sich automatisch anpassen?
Oder beides?

also Spaltenbreite muss gleich bleiben, sonst verschiebt sich die obere Tabelle ungünstig… Die Zeilenhöhe darf und sollte sich anpassen.

Sag mir doch um welchen Zellenbereich es sich handelt, dann
kann ich das gleich richtig schreiben.
Gruß
Reinhard

Die Ausgabe erfolgt in der Spalte B, die mit der Spalte C verbunden ist in verschiedenen Zeilen immer wieder, z.b. 98, 105, 113-117, 126-132 etc…
in den Zellen steht die Formel =BEREICH.VERSCHIEBEN(Source!D5;0;Source!J5)
wobei die Zeilenangabe sich immer unterscheidet…

evtl kannst Du ja mit ActiveCell.Address arbeiten, dann lass’ ich einfach ein Makro durchlaufen, das dann immer wieder Dein Makro aufruft oder so?

Auf jeden Fall vieeeeeelen Dank :smile:)