AW: Passwort mit Sternchen und Userform
29.09.2005 14:25:40
sophie
Hi Matthias,
habe deinen Rat befolgt, leider erfolglos. ich schick dir mal meinen passwortabfragecode, den ich in der Inputbox habe.
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 = "zeynep"
Const passw2 = "rüdiger"
Const passw3 = "bock"
Const passw4 = "krepp"
Const passw5 = "kluth"
Worksheets("Gesamtübersicht").Visible = xlVeryHidden
Worksheets("Produktionsleistung").Visible = xlVeryHidden
Worksheets("Produktionskosten").Visible = xlVeryHidden
Worksheets("Verrechnungskosten").Visible = xlVeryHidden
Worksheets("sonstige Aufwände").Visible = xlVeryHidden
s = InputBox("Geben Sie das Paßwort ein!")
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("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 = passw3 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 = passw4 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 = passw5 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
so das war er. diesen code für die userform habe ich im archiv gefunden. wenn ich den einbaue, passiert nichts:
LassModule: frmPasswort
Private Sub cmdAbbrechen_Click()
MsgBox " kein Zugang!"
Unload Me
End Sub
Private Sub cmdOK_Click()
If txtPasswort.Text = "zeynep" Then
MsgBox " Alles Klar!"
Unload Me
Else
MsgBox "War wohl nix!"
txtPasswort.Text = ""
txtPasswort.SetFocus
End If
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
txtPasswort.SetFocus
End Sub
StandardModule: basMain
Sub CallForm()
frmPasswort.Show
End Sub