Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1724to1728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelle gelockt nach ActiveSheet.protect

Zelle gelockt nach ActiveSheet.protect
03.12.2019 15:47:39
hkoepp63
Hallo Zusammen,
ich muss aus einer Tabelle den Schreibschutz rausnehmen um "gemergte Zellen" in der Zeilenhöhe automatisch anzupassen. Es funktioniert auch alles. Der einzige Fehler ist, daß danach der Schutz der Zelle(n) eingeschlatet wird... Die Zellen J22:S22 müssen aber beschreibbar bleiben.
Anbei der komplette Code:
Option Explicit
'   nach: www.herber.de/mailing/137101h.htm
'   "Zeilenhöhe bei verbundenen Zellen anpassen"
Sub ZeilenhoeheVerbundene(lngZeileNr As Long)
ActiveSheet.Unprotect Password:="***"
'  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      ' Merken zum Wiederherstellen
' ---------------------------------------- Gesamtbreite rechnen
For Each rngM In .Cells
sngMergWid = rngM.ColumnWidth + sngMergWid
Next
sngMergWid = sngMergWid + (.Count - 1) * 0.71
' ----------------- Merge aufheben, Zellbreite auf Gesamtbreite
.MergeCells = False
rngC.ColumnWidth = sngMergWid
' ---------------------------------- max. optim. Höhe ermitteln
.EntireRow.AutoFit
sngHoehe = Application.Max(sngHoehe, rngC.Height)
' --------------------------- Breite und Merge wiederherstellen
rngC.ColumnWidth = sngActWid
.MergeCells = True
End If
End With
End If
Next cc
Rows(lngZeileNr).RowHeight = sngHoehe         ' max. optim. Höhe einstellen
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="***"
End Sub
Sub tst()
ZeilenhoeheVerbundene 20
End Sub
Wie bekomme ich das hin, daß diese Zelle(n) ungeschützt bleiben?
Vielen Dank im Voraus für Eure Hilfe.
Beste Grüße
Hinnerk

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelle gelockt nach ActiveSheet.protect
03.12.2019 16:13:16
Matthias
Hallo
Der Zellschutz ist doch automatisch für alle Zellen eingeschaltet bei einer Mappe
Du hebst einfach den Blattschutz auf, deaktivierst den Zellschutz der gewünschten Zellen
und setzt den Blattschutz wieder. Oder Du deaktivierst den Zellschutz mit im Code.
Einfacher ist es das manuell zu machen, denn Du setzt ja keinen Zellschutz, sondern nur den Blattschutz.
Ist der Blattschutz gesetzt und die Zelle(n) haben keinen Zellschutz, kannst Du sie auch bearbeiten.
Gruß Matthias
AW: Zelle gelockt nach ActiveSheet.protect
04.12.2019 07:12:31
hkoepp63
Hallo Matthias,
das Arbeitsblatt ist schreibgeschützt, da hier verschiedene Formeln und Links hinterlegt sind.
Der Haken für den Blattschutz ist hier rausgenommen, da in dieser Zelle Text eingefügt werden muss.
Nachdem die Zeilenhöhe angepasst wurde, wird plötzlich die Zelle gesperrt...
Gibt es eine Möglichkeit, bei gesperrtem Arbeitsblatt, die Zeilenhöhe anzupassen, bei nicht gesperrter Zelle? Das ist mein Problem.
Vielen Dank für die Hilfe im Voraus.
Anzeige
AW: Zelle gelockt nach ActiveSheet.protect
04.12.2019 07:44:45
hkoepp63
Ich habe es hinbekommen...
'Anfang Blattschutz aufheben
Dim chCell As Range
Dim chRng As Range
ActiveSheet.Unprotect Password:="***"
Range("J22:S22").Locked = False
Set chRng = ActiveSheet.Range("J22:S22")
'Ende Blattschutz aufheben

'Anfang Blattschutz setzen
For Each chCell In chRng.Cells
If chCell.Value  "" Then Cells.Locked = False
Next chCell
ActiveSheet.Protect Password:="glasnost"
' Ende Blattschutz setzen

36 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige