AW: Kopieren etc in einem teils gesperrten Blatt
02.03.2018 16:17:49
fcs
Hallo Michaela,
mit etwas Aufwand kann man das per Makros über den Usernamen steuern mit dem sich der User in Windows anmeldet.
Das VBA-Prprojekt muss dann im VBA-Editor per Kennwort geschützt werden, damit dort nichts manipuliert wird.
Im DropDown kannst du dann auch das "U" in die Ausahlliste übernehmen.
Alternativ könnte man auch beim Öffnen der Datei die Auswahlliste per Makro über den Usernamen anpassen.
Grundproblem: Man muss zusätzlich beim Öffnen der Datei auch sicherstellen, dass die Makros aktiviert sind. Das macht man z.B. so dass man ein zusätzliches Blatt mit Infos einbaut.
Mit dem Workbook_Open-Ereignismakro wird die Visble-Eigenschaft aller relevanten Blätter auf sichtbar gesetzt.
Mit dem Workbook_Before_Close-Ereignismakro wird die Visble-Eigenschaft alle Blätter mit Ausnahme des Info-Blattes auf VeryHidden gesetzt.
Gruß
Franz
'Code unter dem Tabellenblatt nit den Eingaben
Option Explicit
Private mbolLoeschen_U As Boolean 'Merker, dass Zelle(n) mit "U" selektiert wurde(n)
Private Const mcsZellbereich As String = "C4:G8" 'nicht gesperrter Zellbereich - anpassen !!!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range, bolNicht As Boolean
Select Case Environ("Username")
Case "ABC_Schuetze", "xyzMeier" 'Usernamen anpassen !
'diese User dürfen "U" in Zellen eintragen, löschen, kopieren
Case Else 'für alle anderen User
'Eingaben/Änderungen im Zellbereich "msZellbereich" überwachen
If Not Intersect(Target, Range(mcsZellbereich)) Is Nothing Then
If Application.CutCopyMode False Then
For Each Zelle In Target.Cells
Select Case UCase(Zelle.Value)
Case "U"
bolNicht = True
Exit For
End Select
Next
If bolNicht = True Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "angemeldeter User: " & Environ("Username") & vbLf _
& "Sie dürfen keine Zellen mit ""U"" kopieren", _
vbOKOnly, "Zellen kopieren"
Application.CutCopyMode = False
End If
ElseIf mbolLoeschen_U = True Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "angemeldeter User: " & Environ("Username") & vbLf _
& "Sie dürfen Inhalte in Zellen mit ""U"" nicht löschen/überschreiben", _
vbOKOnly, "Inhalte löschen"
ElseIf UCase(Target.Value) = "U" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "angemeldeter User: " & Environ("Username") & vbLf _
& "Sie dürfen den Wert ""U"" im DropDown nicht auswählen", _
vbOKOnly, "DropDown-Auswahl"
End If
End If
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zelle As Range, bolNicht As Boolean
mbolLoeschen_U = False
Select Case Environ("Username")
Case "ABC_Schuetze", "xyzMeier" 'Usernamen anpassen !
'diese User dürfen "U" eintragen/löschen
Case Else
'Zellselektion im Zellbereich "mcsZellbereich" überwachen
If Not Intersect(Target, Range(mcsZellbereich)) Is Nothing Then
For Each Zelle In Target.Cells
Select Case UCase(Zelle.Value)
Case "U"
mbolLoeschen_U = True
Exit For
End Select
Next
End If
End Select
End Sub
'############ Code unter DieseArbeitsmappe #########
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bolSaved As Boolean
Dim objSh As Object
bolSaved = Me.Saved 'Speicherstatus der Arbeitsmappe merken
Me.Worksheets("Info").Activate ' Infoblatt aktivieren
For Each objSh In Me.Sheets
Select Case objSh.Name
Case "Info"
'Dieses Blatt nicht ausblenden
Case Else
objSh.Visible = xlSheetVeryHidden
End Select
Next
If bolSaved = True Then Me.Save
End Sub
Private Sub Workbook_Open()
Dim objSh As Object
'Alle Blätter sichtbar machen
For Each objSh In Me.Sheets
objSh.Visible = xlSheetVisible
Next
Me.Worksheets("Tabelle1").Activate 'Dieses Tabellenblatt anzeigen
End Sub