Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1660to1664
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
Bei Fenster Passworteingabe mit "*"
12.12.2018 16:37:56
Thomas
Hallo
Per klick öffne ich eine Passwortabfrage. Jedoch steht bei Eingabe des Passwortes dort das Passwort, möchte aber, das es per Sternchen angezeigt wird.
Hier der COde:
Private Sub CommandButton1_Click()
Dim sPassWord As String
sPassWord = InputBox("Paßwort eingeben:", , "")
Select Case sPassWord
Case "Passwort"
With Worksheets("Tabelle1")
.Visible = True
.Application.Visible = True
.Select
End With
Case "": Exit Sub
Case Else
Beep
MsgBox "Falsches Passwort eingegeben!"
End Select
Unload Auswahlfenster
End Sub
Vielen Dank für Eure Hilfe

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bei Fenster Passworteingabe mit "*"
12.12.2018 16:40:07
Peter(silie)
Hallo,
geht nicht mit der InputBox.
Erstelle eine UserForm und setze eine TextBox drauf.
Suche nach der Eigenschaft 'PasswordChar' und trage dort das * ein.
AW: Bei Fenster Passworteingabe mit "*"
12.12.2018 19:30:02
Sepp
Hallo Thomas,
das geht z. B. so:
Modul Modul1
Option Explicit 
 
'//////////////////////////////////////////////////////////////////// 
'Password masked inputbox 
'Allows you to hide characters entered in a VBA Inputbox. 
' 
'Code written by Daniel Klann 
'March 2003 
'//////////////////////////////////////////////////////////////////// 
 
 
'API functions to be used 
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 GetCurrentThreadId Lib "kernel32" () As Long 
 
#If VBA7 Then 
Private Declare PtrSafe Function GetClassName Lib "USER32" Alias _
  "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal _
  nMaxCount As LongPtr) As Long 
#Else 
Private Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" (ByVal _
  hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 
#End If 
 
'Constants to be used in our API functions 
Private Const EM_SETPASSWORDCHAR = &HCC 
Private Const WH_CBT = 5 
Private Const HCBT_ACTIVATE = 5 
Private Const HC_ACTION = 0 
 
Private hHook As Long 
 
 
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
  Dim RetVal, 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    'A window has been activated 
 
    RetVal = GetClassName(wParam, strClassName, lngBuffer) 
 
    If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox 
 
      'This changes the edit control so that it display the password character *. 
      'You can change the Asc("*") as you please. 
      SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 
    End If 
 
  End If 
 
  'This line will ensure that any other hooks that may be in place are 
  'called correctly. 
  CallNextHookEx hHook, lngCode, wParam, lParam 
 
End Function 
 
Private Function InputBoxDK(Prompt, Title) 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) 
 
  UnhookWindowsHookEx hHook 
 
End Function 
 
Private Sub CommandButton1_Click() 
  Dim sPassWord As String 
  sPassWord = InputBoxDK("Paßwort eingeben:", "") 
  Select Case sPassWord 
    Case "Passwort" 
      With Worksheets("Tabelle1") 
        .Visible = True 
        .Application.Visible = True 
        .Select 
      End With 
    Case "": Exit Sub 
    Case Else 
      Beep 
      MsgBox "Falsches Passwort eingegeben!" 
  End Select 
     
  Unload Auswahlfenster 
     
End Sub 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige