PDA

Vollständige Version anzeigen : Nach Eingabe soll die Zelle automatisch gesperrt werden


Chris144
19.07.2012, 07:01
Hallo zusammen,

ich habe ein kleines prob. Ich möchte eine Zelle nach der Eingabe automatisch geschützt haben, so dass kein nachträgliches Ändern möglich ist. Habe schon im Netz recherchiert, aber leider noch nicht das passende gefunden. Vielleicht könnt Ihr mir weiterhelfen.

Vielen Dank im Voraus.

MfG

Chris

Hajo_Zi
19.07.2012, 07:03
Hallo Chris,

das geht nur per VBA und die Tabelle muss geschützt sein.

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Chris144
19.07.2012, 07:05
hallo Hajo,

ja das es in VBA geht dachte ich mir schon, nur fehlt mir der Quelltext dazu. Denn VBA ist nicht das Gebiet wo ich fit bin.

chris-kaiser
19.07.2012, 07:49
Hi

der Code liegt im Tabellenblatt -> rechte Maustaste auf dem jeweiligen Blattregister -> Code anzeigen und dort einfügen

ZUVOR

zuerst Zellen markieren in denen eingeben werden sollte -> Zellen formatieren -> und Schutz aufheben.
Danach Blattschutz setzen
Code in die Tabelle kopieren und anpassen.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngT As Range
If Target.Column = 1 Then 'ich habe mal Spalte A angenommen sonst durch z.B Range("A1:G100") oder sonst was erstzen (siehe zweiten Code)
ActiveSheet.Protect Userinterfaceonly:=True 'falls ein PW ist ->ActiveSheet.Protect "Geheim", Userinterfaceonly:=True
For Each rngT In Target
If rngT.Value <> "" Then
rngT.Locked = True
End If
Next
End If
End Sub

für einen Bereich



Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngT As Range
Dim RngB As Range
Set RngB = Range("A1:G100")
If Not Intersect(Target, RngB) Is Nothing Then
ActiveSheet.Protect Userinterfaceonly:=True
For Each rngT In Target
If rngT.Value <> "" Then
rngT.Locked = True
End If
Next
End If
End Sub