Option Explicit

Private m_blnInit    As Boolean
Private m_strPW      As String
Private m_blnCancel  As Boolean

Public Property Let gInit(ByVal blnNewValue As Boolean)
  m_blnInit = blnNewValue
End Property

Public Property Let gTitle(ByVal strNewValue As String)
  If Len(strNewValue) <> 0 Then
    Me.Caption = strNewValue
  Else
    Me.Caption = Application.Name
  End If
End Property

Public Property Let gPrompt(ByVal strNewValue As String)
  Me.lblPrompt.Caption = strNewValue
End Property

Public Property Let gPassword(ByVal strNewValue As String)
  m_strPW = strNewValue
End Property

Public Property Get gCancel() As Boolean
  gCancel = m_blnCancel
End Property

Private Sub UserForm_Initialize()
  With Me
    .cmdCancel.Cancel = True
    .cmdOK.Default = True
    .txtInput.PasswordChar = "*"
  End With
End Sub

Private Sub UserForm_Activate()
  If Not m_blnInit Then Unload Me
End Sub

Private Sub cmdOK_Click()
  If Me.txtInput.Text = m_strPW Then
    m_blnCancel = False
    Me.Hide
  Else
    MsgBox "Ungültiges Passwort!", vbExclamation, Me.Caption
    With Me.txtInput
      .Text = ""
      .SetFocus
    End With
  End If
End Sub

Private Sub cmdCancel_Click()
  m_blnCancel = True
  Me.Hide
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
      CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    cmdCancel_Click
  End If
End Sub

Option Explicit

Public Function GetPassword(ByVal strPrompt As String, _
            ByVal strPassword As String, _
            Optional strTitle As String) As Boolean

  Dim frmPWInput  As FrmPassword

  Set frmPWInput = New FrmPassword
  With frmPWInput
    .gInit = True
    .gTitle = strTitle
    .gPrompt = strPrompt
    .gPassword = strPassword

    .Show
    DoEvents

    GetPassword = (Not .gCancel)
  End With

  Unload frmPWInput
  Set frmPWInput = Nothing
End Function

Public Sub Demo_GetPassword()
  Const cMsgTitle As String = "VB-fun-Demo - Passwortabfrage"

  Dim strPW     As String
  Dim blnRetVal As Boolean

  strPW = "Passwort"
  blnRetVal = GetPassword("Bitte Passwort eingeben:", strPW)
  If blnRetVal = True Then
    MsgBox "Juhuuuu, die Passwort-Eingabe war richtig!", _
           vbInformation, cMsgTitle
  End If
End Sub