AW: Passwortabfage
05.10.2005 15:03:51
sophie
Option Explicit
Dim InI As Integer ' Zählvariable für Register
Dim ByS As Boolean ' Variable für Speicherung
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' ausblenden aller Register außer Tabelle1 mit
' Sheets("....").Visible = xlVeryHidden aus
' dies hat den Vorteil Sie können nur per VBA eingeblendet werden.
Dim Mldg As Byte ' Variable für Schalter MsgBox
' ActiveWorkbook.Unprotect ("Passwort") ' falls Dateischutz
If ActiveWorkbook.Saved Then
' Datei wurde nicht verändert
' eine Tabelle muß min. eingeblendet sein
Sheets("Tabelle1").Visible = True
' alle Tabellen ausblenden vom letzten bis zum ersten
' außer "Tabelle1"
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Tabelle1" Then Sheets(InI).Visible = xlVeryHidden
Next InI
ByS = True
ThisWorkbook.Close True
Else
If ByS = True Then Exit Sub
Mldg = MsgBox(" Sollen die Veränderungen gespeichert werden ?", _
vbYesNo + vbQuestion, "Speicher abfrage ?", "", 0)
If Mldg = 6 Then ' es wurde "Ja" gedrückt
' aktualisierung Bildschirm aus
Application.ScreenUpdating = False
' eine Tabelle muß min. eingeblendet sein
Sheets("Tabelle1").Visible = True
' alle Tabellen ausblenden vom letzten bis zum ersten
' außer "Tabelle1"
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Tabelle1" Then Sheets(InI).Visible = xlVeryHidden
Next InI
' aktualisierung Bildschirm ein
Application.ScreenUpdating = True
' Speichervariable auf True, da Ereignis Workbook_BeforeSave
' augeführt wird
ByS = True
ThisWorkbook.Save
Else
ByS = True
ThisWorkbook.Close False
End If
End If
' ActiveWorkbook.Protect ("Passwort") ' Dateischutz wieder setzen
End Sub
Private Sub Workbook_Open()
' ActiveWorkbook.Unprotect ("Passwort")
' aktualisierung Bildschirm aus
Application.ScreenUpdating = False
' alle Tabellen einblenden vom letzten bis zum ersten
For InI = Sheets.Count To 1 Step -1
Sheets(InI).Visible = True
Next InI
' Tabelle mit Hinweis ausblenden
Sheets("Tabelle1").Visible = False
' Schalter Veränderung der Datei zurückstellen
' Damit das einblenden der Register nicht als Veränderung der Datei angesehen wird
ActiveWorkbook.Saved = True
' aktualisierung Bildschirm ein
Application.ScreenUpdating = True
' ActiveWorkbook.Protect ("Passwort")
End Sub
' Füge ein neues Register ein und schreibe groß drauf "Makro wurden nicht aktiviert"
' in
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' blendest Du alle anderen Register aus
' Das Ausblenden hat den Vorteil das die Register nur über VBA eingeblendet werden können
' und nicht über Format, Blatt, Einblenden.
' VBA Projekt schützen
Private Sub Workbook_Activate()
Dim s As String
Const passw1 = ""
Const passw2 = ""
Const passw3 = ""
Const passw4 = ""
Worksheets("Gesamtübersicht").Visible = xlVeryHidden
Worksheets("Produktionsleistung").Visible = xlVeryHidden
Worksheets("Produktionskosten").Visible = xlVeryHidden
Worksheets("Verrechnungskosten").Visible = xlVeryHidden
Worksheets("sonstige Aufwände").Visible = xlVeryHidden
s = UserForm1.GetPassword
If s = passw1 Then
Worksheets("Gesamtübersicht").Visible = True
Worksheets("Produktionsleistung").Visible = True
Worksheets("Produktionskosten").Visible = True
Worksheets("Verrechnungskosten").Visible = True
Worksheets("sonstige Aufwände").Visible = True
Exit Sub
ElseIf s = passw2 Then
Worksheets("Produktionsleistung").Visible = True
Worksheets("Gesamtübersicht").Visible = xlVeryHidden
Worksheets("Produktionskosten").Visible = xlVeryHidden
Worksheets("Verrechnungskosten").Visible = xlVeryHidden
Worksheets("sonstige Aufwände").Visible = xlVeryHidden
Exit Sub
ElseIf s = passw3 Then
Worksheets("Produktionskosten").Visible = True
Worksheets("Gesamtübersicht").Visible = xlVeryHidden
Worksheets("Produktionsleistung").Visible = xlVeryHidden
Worksheets("Verrechnungskosten").Visible = xlVeryHidden
Worksheets("sonstige Aufwände").Visible = xlVeryHidden
Exit Sub
ElseIf s = passw4 Then
Worksheets("sonstige Aufwände").Visible = True
Worksheets("Gesamtübersicht").Visible = xlVeryHidden
Worksheets("Produktionsleistung").Visible = xlVeryHidden
Worksheets("Produktionskosten").Visible = xlVeryHidden
Worksheets("Verrechnungskosten").Visible = xlVeryHidden
Exit Sub
Else
MsgBox "Sie haben keine Zugriffsrechte. Und Tschüss!"
End If
End Sub
Und das steht in meiner userform!!!
Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
TextBox1 = ""
Unload Me
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then TextBox1 = ""
End Sub
Public Function GetPassword() As String
Me.Show
GetPassword = TextBox1
End Function
Private Sub UserForm_Activate()
TextBox1.SetFocus
End Sub