Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
676to680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
676to680
676to680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Passwortabfage

Passwortabfage
05.10.2005 14:37:30
sophie
Hi Leute,
habe in excel in vba eine passwortabfrage eingerichtet. das problem hierbei ist, daß wenn ich die datei minimiere und sie dann wieder vergrößere, ich jedesmal nach meinem passwort gefragt werde. gibt es dafür einen code um es zu vermeiden? ihr würdet mir damit sehr helfen

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Passwortabfage
05.10.2005 14:58:55
MichaV
Hallo,
zeig doch mal Deinen bisherigen Code.
Gruß- Micha
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

Anzeige
AW: Passwortabfage
05.10.2005 15:14:38
MichaV
Hallo,
das ist ja eine richtige Abendlektüre ;o) ....guck ich mir heut abend in Ruhe an, falls sich kein anderer findet.
Gruß- Micha
AW: Passwortabfage
05.10.2005 15:21:46
sophie
oh das wäre echt klasse. bräuchte die lösung ganz dringend..
bleibt offen
05.10.2005 15:23:25
MichaV
AW: Passwortabfage
05.10.2005 22:02:42
MichaV
Hallo Sophie,
pack den Code aus Private Sub Workbook_Activate() in die Private Sub Workbook_Open()
Gruß- Micha
AW: Passwortabfage
06.10.2005 09:30:39
sophie
Hi Micha,
du hast mir wirklich geholfen... warst meine Rettung.
klappt alles perfekt.
vielen vielen Dank!!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige