Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1256to1260
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1256to1260
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zellschutz für best. Bereich

Zellschutz für best. Bereich
Matthias
Hallo @All,
da bin ich schon wieder, diesmal mit folgenden Code Zeilen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
ActiveSheet.Unprotect
For i = 1 To Target.Count
If Target(i)  "" Then Target(i).Locked = 1
Next i
ActiveSheet.Protect
End Sub
Habe gleich 2 Aufgaben für Euch
1 , diesen Code brauche ich nur im Bereich D4:Q33 (-locked)
2 , wie müßte ich das ganze wieder aufheben (-unloocked)
Gruß Matthias

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellschutz für best. Bereich
01.04.2012 18:23:54
Hajo_Zi
Hallo Matthias,
Du hast nicht geschrieben wann aufheben. Ich habe es jetzt als umkehr programmiert.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range                  ' Variable für Bereich
Dim RaZelle As Range                    ' Variable für Zelle
' Bereich der Wirksamkeit
Set RaBereich = Range("D4:Q33")
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
ActiveSheet.Unprotect
For Each RaZelle In RaBereich
With RaZelle
RaZelle.Locked = Not RaZelle.Locked
Next RaZelle
ActiveSheet.Protect
End If
Set RaBereich = Nothing                 ' Variable leeren
End Sub

Anzeige
@Hajo - vergessen zu erwähnen,...
01.04.2012 18:40:44
Matthias
Hallo Hajo,
habe glatt vergessen das es 2 getrennt Makros werden sollen,
vorab schon einen recht schönen Dank für die komplett Varriante.
Gruß Matthias
AW: @Hajo - vergessen zu erwähnen,...
01.04.2012 18:43:43
Hajo_Zi
Hallo Mattias,
dann den Code so 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range                  ' Variable für Bereich
Dim RaZelle As Range                    ' Variable für Zelle
' Bereich der Wirksamkeit
Set RaBereich = Range("D4:Q33")
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
ActiveSheet.Unprotect
For Each RaZelle In RaBereich
With RaZelle
RaZelle.Locked = RaZelle  ""
Next RaZelle
ActiveSheet.Protect
End If
Set RaBereich = Nothing                 ' Variable leeren
End Sub
Sub Aufheben()
Dim RaBereich As Range                  ' Variable für Bereich
Dim RaZelle As Range                    ' Variable für Zelle
' Bereich der Wirksamkeit
Set RaBereich = Range("D4:Q33")
ActiveSheet.Unprotect
For Each RaZelle In RaBereich
With RaZelle
RaZelle.Locked = False
Next RaZelle
ActiveSheet.Protect
Set RaBereich = Nothing                 ' Variable leeren
End Sub
Gruß Hajo
Anzeige
AW: @Hajo - besten Dank --owT.
01.04.2012 18:47:19
Matthias

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige