Automatische Zellenhöhe bei verbunden Zellen
20.07.2018 13:09:15
Sascha
mir wurde bei meinem letzten Problem so schnell und freundlich geholfen, da dachte ich, ich versuche es gleich nochmal :)
Ich habe aus dem Archiv
https://www.herber.de/forum/archiv/940to944/943338_Automatische_Zellenhoehe_bei_verbunden_Zellen.html
folgenden Code gemopst:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, arrZ, colZ As New Collection, ii As Long
arrZ = Array(11, 28, 30, 32, 34, 36, 38, 41) ' Nummern der überwachten Zeilen anpassen
For Each rng In Target
If Not IsError(Application.Match(rng.Row, arrZ, 0)) Then
On Error Resume Next
colZ.Add rng.Row, CStr(rng.Row)
On Error GoTo 0
End If
Next rng
For ii = 1 To colZ.Count
ZeilenhoeheVerbundene colZ(ii)
Next ii
Set colZ = New Collection
End Sub
' nach: www.herber.de/mailing/137101h.htm
' "Zeilenhöhe bei verbundenen Zellen anpassen"
Sub ZeilenhoeheVerbundene(lngZeileNr As Long)
' Parameter ist die Zeilennummer.
' In einer Zeile kann es mehrere verbundene Zellen geben.
Dim sngHoehe As Single, cc As Integer, RngC As Range
Dim sngActWid As Single, rngM As Range, sngMergWid As Single
Application.ScreenUpdating = False
With Rows(lngZeileNr)
.AutoFit
sngHoehe = .RowHeight ' Mindesthöhe (insbes. nicht-verbundene Zellen)
End With
For cc = 1 To Cells(lngZeileNr, Columns.Count).End(xlToLeft).Column
If Cells(lngZeileNr, cc) > "" And Cells(lngZeileNr, cc).MergeCells Then
Set RngC = Cells(lngZeileNr, cc)
If Len(RngC) > 1000 Then
MsgBox "Der Text in " & RngC.Address(0, 0) & " hat über 1000 Zeichen !" _
& vbLf & vbLf & "Bitte kürzen!", vbCritical, "ZeilenhoeheVerbundene"
RngC.Select
Exit Sub
End If
With RngC.MergeArea
If .Cells(1).Address = RngC.Address And .WrapText = True Then
sngActWid = RngC.ColumnWidth
For Each rngM In .Cells
sngMergWid = rngM.ColumnWidth + sngMergWid
Next
sngMergWid = sngMergWid + (.Count - 1) * 0.71
.MergeCells = False
RngC.ColumnWidth = sngMergWid
.EntireRow.AutoFit
sngHoehe = Application.Max(sngHoehe, RngC.Height)
RngC.ColumnWidth = sngActWid
.MergeCells = True
End If
End With
End If
Next cc
Rows(lngZeileNr).RowHeight = sngHoehe
Application.ScreenUpdating = True
End Sub
1.
Das Tabellenblatt soll, um ungewollte Änderungen an den Daten zu verhindern, mit Blattschutz geschützt sein.
Die betroffenen verbunden Zellen, in denen der Text eingegeben wird und die Zeilenhöhe dann automatisch angepasst wird, sind darum natürlich ohne Schutz.
Aber sobald ich einen langen Text angebe, und die Zeilenhöhe angepasst wird, ist sind 4 von den 5 verbundenen Zellen wieder geschützt. Das hat zur Folge, dass bei einer weiteren Eingabe in die Zelle die Fehlermeldung "Die Autofit-Methode des Range-Objektes konnte nicht ausgeführt werden.
Ich habe es bereits mit protect/unprotect im scribt versucht, hat aber auch nichts bewirkt.
2.
Ich habe in einer Zeile Zwei Texteingabebereiche, die jeweils aus 3 verbundenen Zellen bestehen.
Gebe ich nun in den ersten Bereich einen langen Text ein, passt sich die Höhe wie gewollt an. Gebe ich dann einen Text, der länger als der Erste ist, in den zweiten Bereich ein, passiert nichts mehr.
Hat da jemand eine Idee ob, und wenn ja wie man das beheben kann?
Punkt 1 wäre mir da am Wichtigsten... :)
Danke im Voraus und viele Grüße,
Sascha