So muesste es jetzt passen ...
30.09.2004 09:44:53
Volker Croll
Hallo Konni,
danke fuer's zumailen Deiner "Problem"-Datei.
Abgesehen von den bereits angesprochenen Tippfehlern im Makro ist es - entsprechend Deiner Anforderung - am Besten, das Worksheet_Change-Ereignis zu benutzen (Hans loest in seinem Beispiel die Veraenderung der Zeilenhoehe durch eine Schaltflaeche aus).
Somit gehoert der Codetext (wie von Dir versucht) weder in ein Modul, noch wird er im VBAProject unter "DieseArbeitsmappe" eingefuegt, sondern (so wie Du die Tabelle benannt hast) unter "Tabelle211 (Punkt1.00)".
Grundsaetzlicher Hinweis:
Um Tippfehler aufzuspuehren und damit man nicht vergisst alle Variablen zu deklarieren, sollte ueber jedem Makro stehen "Option Explicit"; dann meckert Excel, wenn etwas nicht stimmt.
Das kann man im VBA-Editor automatisieren ueber EXTRAS, OPTIONEN, Haken setzen vor "Variablendeklaration erforderlich".
Wichtig damit dieses Makro funktioniert ist weiterhin, dass fuer die verbundene Zelle D13 der Zeilenumbruch aktiviert ist. Dies war in Deiner Tabelle bisher nur zum Teil der Fall. Zu erkennen ueber: D13 markieren, FORMAT, ZELLEN..., Register AUSRICHTUNG, ZEILENUMBRUCH. Der Haken dort ist zwar gesetzt gewesen, aber der Hintergrund ist grau. Vermutlich hast Du vor dem Verbinden der Zellen den Zeilenumbruch nur fuer D13 gesetzt. Also einmal auf den Haken klicken, der Hintergrund wird weiss, dann OK.
Das Makro muesste nun so funktionieren, wie Du Dir das vorgestellt hast. Zusaetzlich habe ich noch das Worksheet_SelectionChange-Ereignis eingebaut, um u.a. die Zeilenhoehe noch Loeschen eines Textes aus D13 zurueckzusetzen.
Alle anderen Ergaenzungen habe ich im Makro entsprechend kommentiert; falls doch noch Fragen, einfach melden.
Anzumerken ist noch (bitte nicht krumm nehmen), dass ich den Aufbau der Tabelle fuer etwas ungluecklich halte. Dass ich grundsaetzlich absolut nichts von verbundenen Zellen halte, habe ich ja schon geschrieben (auch diese Tabelle koennte man ganz ohne aufbauen).
In Deinem Fall besteht die verbundene D13 aus 20(!) Spalten. Natuerlich weiss ich nicht, ob diese Tabelle nur ein Ausschnitt ist, sprich die Spalten noch anderswo gebraucht / angesprochen werden. Deshalb bezieht sich nachfolgendes auf diese Tabelle, wenn sie so fuer sich alleine eingesetzt wird.
Wenn schon verbinden, dann koenntest Du zumindestens mit wesentlich weniger Spalten auskommen, wenn Du einzelne breiter machen wuerdest. Zum Beispiel die Spalte E sehr breit ziehen, statt E bis S zu verbinden, etc.
Hinzukommt, dass dadurch, dass in D13 20 Spalten verbunden sind, das Makro relativ langsam ist, weil es ja alle Verbindungen zerlegt und rechnet. Das faellt zwar auf aktuellen PCs kaum ins Gewicht fallen, ist bei aelteren Modellen aber halt einfach laestig.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
' Unter Verwendung von Excel-Beispiel Nr.137101,
' "Zeilenhöhe bei verbundenen Zellen anpassen"
' von Hans W. Herber, 53567 Asbach,
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If Target.Address = "$D$13" Then
If Range("D13").MergeCells Then
' Bei sehr langen Text berechnet Excel (auch bei nicht verbundenen Zellen!) die
' optimale Zeilehoehe (AutoFit) nicht mehr richtig, deshalb Pruefung der Textlaenge:
If Len(Range("D13")) > 1000 Then
MsgBox "Der von Ihnen eingegebene Text umfasst mehr als 1000 Zeichen !" & Chr(10) & _
"Bitte kürzen Sie ihn entsprechend !", 48, "Text zu lang !"
' direkte Rueckkehr zur falsch ausgefuellten Zelle. Damit der User aber nicht
' komplett neu eingeben muss, wird der zulange Text trotzdem nicht geloescht:
Range("D13").Select
Exit Sub
End If
Application.ScreenUpdating = False
' Die Zeilenhoehe ist von Excel begrenzt auf 409. Durch eine Veraenderung der
' Schriftgroesse koennte diese Grenze ueberschritten werden. Ausserdem wuerde der
' Ausdruck dann nicht mehr auf eine Seite passen. Somit wird die Schriftgroesse
' wieder zurueckgesetzt. Vorgenommene Formatierungen (fett, unterstrichen o.a.)
' koennen durchaus gewollt und sinnvoll sein, werden also nicht zurueckgesetzt:
With Range("D13").Font
.Name = "Arial"
.Size = 8.5
End With
Range("D13").RowHeight = 21
With Range("D13").MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = Range("D13").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
Application.ScreenUpdating = True
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
' Falls die Meldung ueber eine zulange Texteingabe in D13 ignoriert wurde, wird der User
' ueber diesen Fehler informiert, wenn er eine andere Eingabezelle auswaehlt; aber -->
' der Inhalt von D13 darf nur geprueft werden, wenn die Markierung nicht in Zeile 13 oder
' Zeile 14 steht (fuehrt sonst unmittelbar nach einer zu langen Eingabe in D13 zu einer
' wechselseitigen Ausloesung von Worksheet_Change und Worksheet_SelectionChange):
If Target.Row = "13" Or Target.Row = "14" Then
Exit Sub
End If
If Len(Range("D13")) > 1000 Then
MsgBox "Der Text in Zelle D13 umfasst mehr als 1000 Zeichen !" & Chr(10) & _
"Bitte kürzen Sie ihn entsprechend !", 48, "Text in D13 zu lang !"
Range("D13").Select
Exit Sub
End If
' Wird ein Text in D13 ueber die Entf-Taste geloescht, ist dies fuer Excel kein
' Worksheet_Change Ereignis! Deshalb wird beim Auswaehlen einer beliebigen Zelle geprueft,
' ob D13 leer ist und die Zeilenhoehe ungleich 21 ist; ggf. wird zurueckgesetzt:
If Range("D13") = "" And Rows("13").RowHeight <> 21 Then
Rows("13").RowHeight = 21
End If
End Sub
Gruss
Volker Croll
www.crolltools.de