Hallo Herr Fischer,
da ist mir beim Testen ein Sicherheits-Risiko aufgefallen:
=> man kann in einer Excel (auch mit Blattschutz + ausgeblendeten Zeilen) den Bereich dennoch kopieren und in eine neue Excel einfügen - dann wird alles sichtbar !
Lösung: bei Eingabe von Schüler-Password wird die Excel in eine PDF exportiert und die Excel ohne Chance auf irgend einen Zugriff geschlossen. Der Lehrer kann sie weiterhin als Excel bearbeiten und speichern - funktioniert prima - Code siehe unten.
NB: wenn das für Sie (oder andere) hilfreich ist - ich freue mich auf ein Feedback - beste Grüsse.
Public Sub Auto_Open()
Dim Password As String
Dim Zeile As Integer
Dim NewFileName As String
'Schritt 1: Aufruf des Password-Eingabefeldes
'Sheets("Schulnoten").Select
Password = InputBox("Bitte Password eingeben:")
'Schritt 2: Abfrage nach Lehrer-Password
If Password = "Lehrer" Then
Sheets("Schulnoten").Unprotect "Blattschutz" 'Blattschutz aufheben
Rows("6:70").Select 'alle Zeilen auswählen
Selection.EntireRow.Hidden = False 'alle Zeilen einblenden
Range("D6").Select
Exit Sub
Else
End If
'Schritt 3: Abfrage nach Schüler-Password
'Schritt 3.1: Der Bildschirmschoner wird aktiviert
Application.ScreenUpdating = False 'Bildschirmschoner "EIN"
'Schritt 3.3: Der Blattschutz wird aufgehoben
Sheets("Schulnoten").Unprotect "Blattschutz" 'Password für Blattschutz bitte ändern
'Schritt 3.3: Die Zeilen 6:50 werden eingeblendet
Rows("6:70").Select
Selection.EntireRow.Hidden = False
'Schritt 3.4: Die Spalte "C" wird ab Zeile 6 nach unten durchlaufen bis der Eintrag "END" kommt
'...und alle Zeilen werden ausgeblendet, welche nicht mit Password matchen
Zeile = 6
Do Until Cells(Zeile, 3).Text = "END" 'bis Eintrag "END" kommt
If Cells(Zeile, 3).Text <> Password Then 'wenn Zellinhalt ungleich Password
Cells(Zeile, 3).Select
Selection.EntireRow.Hidden = True 'Zeilen ausblenden
Else
If Cells(Zeile, 3).Text = "" Then 'wenn Zellinhalt leer ist
Cells(Zeile, 3).Select
Selection.EntireRow.Hidden = True 'Zeilen ausblenden
Else
End If
End If
Zeile = Zeile + 1
Loop
'Schritt 3.5 Der Blattschutz wird wieder eingerichtet
Sheets("Schulnoten").Protect "Blattschutz" 'Password für Blattschutz bitte ändern
'Schritt 3.6: Der Bildschirmschoner wird wieder deaktiviert
Application.ScreenUpdating = True 'Bildschirmschoner "AUS"
'Schritt 3.7: Das Makro speichert die Datei unter bisherigem File-Namen als PDF mit Zusatz "PDF-KOPIE"
NewFileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & " PDF-KOPIE" & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFileName
'Schritt 3.8: Die Excel wird gespeichert und geschlossen
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
End Sub
Public Sub Auto_Close()
'Schritt 1: Das Blendet die Zeilen 6:50 aus
Sheets("Schulnoten").Unprotect "Blattschutz" 'Blattschutz aufheben
Sheets("Schulnoten").Select
Rows("6:70").Select
Selection.EntireRow.Hidden = True
'Schritt 2: Das Makro richtet den Blattschutz wieder ein
Sheets("Schulnoten").Protect "Blattschutz"
'Schritt 3: Speichern der Datei vor dem Schliessen
ActiveWorkbook.Save
End Sub
|