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 
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 
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 
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 )