Office: (Office 2007) Passwortabfrage mit Inputbox

OfficeUser · 30. Juni 2008

Hallo,

Ulli wieder mit Problem. *frown.gif*
Wie muß mein Code erweitert werden, um bei einer falschen PW - Eingabe, erneut nach dem PW zu fragen, ohne die Spalten vorher einzublenden.

Sub Rechteck2_BeiKlick()

    Dim Passwort

    Passwort = InputBox("Passwort eintragen")

    If Passwort = "PW" Then [a1:I100].EntireColumn.Hidden = False

End Sub

Code eingefügt mit Syntaxhighlighter 4.15
Gruß Ulli

:)

NoNet · 2. Juli 2008

Hallo Ulli,

versuche es mal mit diesem Code :

Sub Rechteck1_BeiKlick()
Dim strPasswort As String, strPWOK As String
strPWOK = "PW" 'das korrekte Passwort !
Do
strPasswort = InputBox("Passwort eintragen (oder leer lassen für Abbruch)")
Loop Until strPasswort = strPWOK Or strPasswort = ""

If strPasswort = strPWOK Then [A:I].EntireColumn.Hidden = False
End Sub
Code eingefügt mit
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mumpel · 2. Juli 2008

Hallo!

Eine Möglichkeit ohne Deklarationen.

Sub Rechteck2_BeiKlick()
Anfang:
If InputBox("Bitte Passwort eingeben") = "PW" Then
Columns("A:I").EntireColumn.Hidden = False
Else
If MsgBox("Das Passwort ist ungültig! Möchten Sie es nochmals versuchen?", _
vbYesNo, "Fehler") = vbYes Then GoTo Anfang
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code eingefügt mit Hilfe zum Programm)

Gruß, René

ulli2 · 2. Juli 2008

Hallo NoNet, Hallo René

Danke für die schnelle Hilfe.
Was bedeutet "Ohne Deklaration"

Gruß Ulli

mumpel · 2. Juli 2008

Du hast in Deinem Code die Inputbox mit Dim Passwort deklariert. Das ist in der Regel nicht immer notwendig. In meinem Code frage ich den Inhalt mit If Inputbox und bei der MsgBox die Auswahl mit If MsgBox ab. Somit ist eine Deklaration (Dim) nicht notwendig.

ulli2 · 2. Juli 2008

Danke René, Ziel erkannt

Gruß Ulli

tgasau · 29. September 2008

Hi zusammen,

kann man die InputBox so formatieren, dass man das Passwort bei der Eingabe nicht lesen kann? Also dass dort nur ******* also Passwortsternchen zu sehen sind?

Danke und viele Grüße
Till *Smilie

mumpel · 29. September 2008

Hallo!

Das geht nicht ohne Weiteres. Soetwas geht nur per API.

Hier zuerst die API-Deklaration. Code stammt von Nepumuk.

Option Explicit

Private Declare Function GetVbaProjekt Lib "vba332.dll" Alias "EbGetExecutingProj" _
(hVBA As Long) As Long
Private Declare Function GetFunktionsnummerString Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hVBA As Long, ByVal strFuncNameUnicode As String, strFunktionsnummer As String) As Long
Private Declare Function GetFunktionsnummerLong Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
(ByVal hVBA As Long, ByVal strFunktionsnummer As String, hlngFunction As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) _
As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Private Enum Constant
EM_SETPASSWORDCHAR = &HCC
GW_CHILD = 5
GW_HWNDFIRST = 0
GW_HWNDNEXT = 2
End Enum

Private hlngTimerKennung As Long

Private Function PasswortHolen(Optional Beschriftung As String) As String
If Beschriftung = "" Then Beschriftung = "Geben sie ihr Passwort ein!"
TimerSetzen
PasswortHolen = InputBox(Beschriftung)
End Function

Private Sub Passwortchar()
Dim hwnd&, hwnd1&, lngRück&, Klasse$
Dim Stil As Long
hwnd = FindWindow("#32770", "Microsoft Excel")
hwnd1 = GetWindow(hwnd, GW_CHILD)
Do
Klasse = String(255, 0)
lngRück = GetClassName(hwnd1, Klasse, 250)
Klasse = Left$(Klasse, InStr(1, Klasse, Chr(0)) - 1)
If LCase(Klasse) = "edit" Then SendMessageBynum hwnd1, EM_SETPASSWORDCHAR, 42, 0
hwnd1 = GetWindow(hwnd1, GW_HWNDNEXT)
Loop While hwnd1 <> 0
End Sub

Private Sub TimerSetzen()
hlngTimerKennung = SetTimer(0, 0, 1000, AddressOf ApiTimer1)
If hlngTimerKennung = 0 Then MsgBox "Fehler beim Initialisieren des Timers"
End Sub

Private Sub TimerZerstören()
If hlngTimerKennung <> 0 Then KillTimer 0, hlngTimerKennung
End Sub

Private Sub ApiTimer1(ByVal hwndOwner&, ByVal lngWindowMessage&, ByVal hlngRückTimerKennung&, _
ByVal lngTickCount&)
TimerZerstören
Passwortchar
End Sub

Private Function GetFuncAdress&(strFunktion$)
Dim hVBA&, lngRück&, strFunktionsnummer$
Dim hlngFunction&, strFuncNameUnicode$
strFuncNameUnicode = StrConv(strFunktion, vbUnicode)
GetVbaProjekt hVBA
If hVBA <> 0 Then
lngRück = GetFunktionsnummerString(hVBA, strFuncNameUnicode, strFunktionsnummer)
If lngRück = 0 Then
lngRück = GetFunktionsnummerLong(hVBA, strFunktionsnummer, hlngFunction)
If lngRück = 0 Then GetFuncAdress = hlngFunction
End If
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier mein angepasstes Makro.

Sub Password()
Anfang:
If PasswortHolen("Bitte Passwort eingeben") = "PW" Then
Columns("A:I").EntireColumn.Hidden = False
Else
If MsgBox("Das Passwort ist ungültig! Möchten Sie es nochmals versuchen?", _
vbYesNo, "Fehler") = vbYes Then GoTo Anfang
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß, René

Office: (Office 2007) Passwortabfrage mit Inputbox

Passwortabfrage mit Inputbox

Passwortabfrage mit Inputbox

Passwortabfrage mit Inputbox

Passwortabfrage mit Inputbox

Passwortabfrage mit Inputbox - Similar Threads - Passwortabfrage Inputbox

Ständige Passwortabfrage und Kalendersyncronisations Fehler

Passwortabfrage

Mehrfache Passwortabfrage

keine Passwortabfrage mehr

Drop Down Menu mit Passwortabfrage in Excel (2003)

Keine Passwortabfrage beim Aufruf schreibgeschützter Dateien

Passwortabfrage für Archivdatei