Option Explicit

Private m_blnInit    As Boolean
Private m_strInput   As String
Private m_blnCancel  As Boolean

Public Sub gInit(ByVal strPrompt As String, ByVal strTitle _
      As String, Optional ByRef varDefault As Variant)

  With Me
    If Len(strTitle) <> 0 Then
      .Caption = strTitle
    Else
      .Caption = Application.Name
    End If

    .lblPrompt = strPrompt

    If IsArray(varDefault) Then
      With .cboInput
        .Style = fmStyleDropDownList
        .List = varDefault
      End With
      Erase varDefault

    Else
      With .cboInput
        .Style = fmStyleDropDownCombo
        .ShowDropButtonWhen = fmShowDropButtonWhenNever

        If Not IsMissing(varDefault) Then
          .Text = varDefault
        Else
          .Text = ""
        End If

        .SelStart = 0
        .SelLength = Len(.Text)
      End With
    End If

    .cboInput.SetFocus
  End With

  m_blnInit = True
End Sub

Public Property Get gInput() As String
  gInput = m_strInput
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
  End With
End Sub

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

Private Sub cmdOK_Click()
  m_blnCancel = False
  m_strInput = Me.cboInput.Text
  Me.Hide
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 InputBoxExt(ByVal strPrompt As String, _
          Optional ByVal strTitle As String, _
          Optional ByRef varDefault As Variant) As Boolean

  Dim frmInputBox As FrmInputBoxExt
  Dim blnOK       As Boolean

  Set frmInputBox = New FrmInputBoxExt

  With frmInputBox
    .gInit strPrompt, strTitle, varDefault
    .Show

    DoEvents

    blnOK = (Not .gCancel)
    If blnOK Then
      varDefault = .gInput
    End If
  End With

  Unload frmInputBox
  Set frmInputBox = Nothing

  InputBoxExt = blnOK
End Function

Public Sub Demo_GetUserInput_1()
  Const cMsgTitle As String = _
        "VB-fun-Demo - InputBox im eigenen Design"

  Dim blnRetVal   As Boolean
  Dim varDefault  As Variant

  varDefault = "VB-fun"
  blnRetVal = InputBoxExt("Bitte geben Sie einen Namen ein:", _
        cMsgTitle, varDefault)

  If blnRetVal = True Then
    If Len(varDefault) > 0 Then
      MsgBox "Eingabe im Textfeld:" & vbCrLf & varDefault, _
             vbInformation, cMsgTitle
    Else
      MsgBox "Es wurden keine Eingaben im Textfeld " & _
             "gemacht, aber die Schaltfläche 'OK' gewählt!", _
             vbInformation, cMsgTitle
    End If
  End If
End Sub

Public Sub Demo_GetUserInput_2()
  Const cMsgTitle As String = _
        "VB-fun-Demo - InputBox im eigenen Design"

  Dim blnRetVal   As Boolean
  Dim varDefault  As Variant
  
  varDefault = Array("Äpfel", "Bananen", "Birnen")
  blnRetVal = InputBoxExt("Bitte wählen Sie einen Artikel aus:", _
        cMsgTitle, varDefault)

  If blnRetVal = True Then
    If Len(varDefault) > 0 Then
      MsgBox "Auswahl in Listenfeld:" & vbCrLf & varDefault, _
             vbInformation, cMsgTitle
    Else
      MsgBox "Es wurde nichts ausgewählt, aber die " & _
             "Schaltfläche 'OK' geklickt!", vbInformation, _
             cMsgTitle
    End If
  End If
End Sub