Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
verschlüsselte Eingabe mit InputBox
zurück: Erklärung zu Sverweis weiter: Makro zum korrrekten Export als .CSV für Shops Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
fridgenep
Gast


Verfasst am:
27. März 2006, 20:21
Rufname:

verschlüsselte Eingabe mit InputBox - verschlüsselte Eingabe mit InputBox

Nach oben
       

Hallo zusammen,

mit folgendem Code könnt ihr verschlüsselten Eingaben in einer Inputbox machen. Den Code in ein allgemeines Modul packen.

Code:
Option Explicit
'Code geschrieben von Daniel Klann
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam 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 GetCurrentThreadId Lib "kernel32" () As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
 If lngCode = HCBT_ACTIVATE Then
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
 End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function


Die Inputbox wie gewöhnlich aufrufen, dabei nur diese Bezeichnung benutzen: InputboxDK

Der Code könnte zum Beispiel so aussehen:

Code:
Option Explicit

Private Sub CommandButton1_Click()
Dim strPw As String
strPw = "test"
 If InputBoxDK("Bitte Passwort eingeben...", "Passwort") <> strPw Then
    MsgBox ("Falsches Passwort!")
    Exit Sub
 Else
    ActiveSheet.Unprotect strPw
    MsgBox ("Blattschutz aufgehoben!")
 End If
End Sub



Viel Spaß.
fridgenep
Gast


Verfasst am:
19. Apr 2006, 20:52
Rufname:

AW: verschlüsselte Eingabe mit InputBox - AW: verschlüsselte Eingabe mit InputBox

Nach oben
       

Hallo zusammen,

der obige Code funktioniert nicht unter Excel 97.

Wer es dennoch unter Excel 97 zum Laufen kriegen will, der sollte den folgenden Code nehmen. Das ist eine Erweiterung des obigen Codes durch Nepumuk (ich hab keine Aktien drin).

Code:
Option Explicit

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" ( _
    ByRef hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" ( _
    ByVal hProject As Long, _
    ByVal strFunctionName As String, _
    ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" ( _
    ByVal hProject As Long, _
    ByVal strFunctionId As String, _
    ByRef lpfn As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
    (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam 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 GetCurrentThreadId Lib "kernel32" () As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long

Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long, lResult As Long, lpfn As Long
    Dim strID As String, strFuncNameUnicode As String
   
    Const NO_ERROR = 0
    AddrOf = 0
   
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
   
    Call GetCurrentVbaProject(hProject)
   
    If hProject <> 0 Then
        lResult = GetFuncID(hProject, strFuncNameUnicode, strID)
        If lResult = NO_ERROR Then
            lResult = GetAddr(hProject, strID, lpfn)
            If lResult = NO_ERROR Then: AddrOf = lpfn
        End If
    End If
   
End Function

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim RetVal          As Variant
        Dim strClassName    As String
        Dim lngBuffer       As Long

    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
strClassName = String$(256, " ")
lngBuffer = 255
 
 If lngCode = HCBT_ACTIVATE Then
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
 End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
        Dim lngModHwnd      As Long
        Dim lngThreadID     As Long

lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function


Der Aufruf erfolgt wie oben beschrieben.

Viel Spaß beim Probieren und Anwenden.
ae
Mein Name ist Ente


Verfasst am:
21. Apr 2006, 17:46
Rufname: Andreas
Wohnort: Reppenstedt bei Lüneburg


AW: verschlüsselte Eingabe mit InputBox - AW: verschlüsselte Eingabe mit InputBox

Nach oben
       

Bitte hier in den Tipps und Tricks keine Fragen zu den Beiträgen.

Bezieht euch im Forum auf den entsprechenden Beiträgen aus den Tipps und Tricks und stellt dort eure Fragen.

So bleiben die Tipps und Tricks übersichtlich -

Beitrag für weitere Fragen gesperrt

_________________
Gruß
Andreas E
------
Oh Mann, ich fühl mich heute wie =DATEDIF(DATUM(1961;6;12);HEUTE();"y") Jahre alt
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Letzen Eingabe mit der 1. Eingabe Subtrahieren 2 Ike 375 20. Nov 2007, 22:50
Gast Letzen Eingabe mit der 1. Eingabe Subtrahieren
Keine neuen Beiträge Excel Formeln: Nur Zahlenfolgen als mögliche Eingabe in Zelle zulassen. 3 Gintonic39 1718 18. Apr 2007, 17:25
Gast Nur Zahlenfolgen als mögliche Eingabe in Zelle zulassen.
Keine neuen Beiträge Excel Formeln: WENN Daten dann Datum der Eingabe 7 Placebo 1711 28. März 2007, 09:47
Auch Gast WENN Daten dann Datum der Eingabe
Keine neuen Beiträge Excel Formeln: Bei einer Eingabe, soll immer der unterste Wert angenommen w 3 neokata 595 12. März 2007, 14:29
neokata Bei einer Eingabe, soll immer der unterste Wert angenommen w
Keine neuen Beiträge Excel Formeln: excel berechnet zellen bei jeder eingabe neu? 7 borsti8 6478 07. Feb 2007, 16:07
borsti8 excel berechnet zellen bei jeder eingabe neu?
Keine neuen Beiträge Excel Formeln: wenn keine Eingabe, dann leeres Feld. Wie geht das? 2 Saarländerin 1606 31. Jan 2007, 11:41
Saarländerin wenn keine Eingabe, dann leeres Feld. Wie geht das?
Keine neuen Beiträge Excel Formeln: Doppelte Eingabe von Werten verhindern! 5 Caro007 989 06. Dez 2006, 13:18
Kaischi Doppelte Eingabe von Werten verhindern!
Keine neuen Beiträge Excel Formeln: Habe Probleme mit der eingabe der Uhrzeit 5 Reto_m 885 01. Okt 2006, 11:54
Reto_m Habe Probleme mit der eingabe der Uhrzeit
Keine neuen Beiträge Excel Formeln: Nach jeder Eingabe aktualisierung der Verknüpfung realisiere 0 HJürgen 791 27. Sep 2006, 08:58
HJürgen Nach jeder Eingabe aktualisierung der Verknüpfung realisiere
Keine neuen Beiträge Excel Formeln: Eingabe von "ODER" in eine Wenn-Funktion 5 awi 916 28. Apr 2006, 23:13
Günni Eingabe von "ODER" in eine Wenn-Funktion
Keine neuen Beiträge Excel Formeln: Eingabe 75' ... gewünschtes Ergebnis 1:15 h 5 Rolf-D. 607 21. Apr 2006, 19:46
Rolf-D. Eingabe 75'   ... gewünschtes Ergebnis 1:15 h
Keine neuen Beiträge Excel Formeln: zelle leeren nach eingabe 1 Gast 913 13. Apr 2006, 22:33
fridgenep zelle leeren nach eingabe
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Expression Web