Macro with a Password Prompt routine

I am trying to complete a toolbar that will lock and unlock all the sheets in a workbook. While I can set the password automatically I'd like to have the macro ask for the password instead of hardcoding it.

Here is the code I currently have and works so long as I have already set the password in the workbook to match what is in the macro

on Explicit
 
Public Const ToolBarName As String = "Password Protect Worksheets"
 
 
'===========================================
Sub CreateMenubar()
 
    Dim iCtr As Long
 
    Dim MacNames As Variant
    Dim CapNamess As Variant
    Dim TipText As Variant
 
    Call RemoveMenubar
 
    MacNames = Array("Protect", _
                     "unprotect")
 
    CapNamess = Array("Lock Sheets", _
                      "Un-Lock Sheets")
 
    TipText = Array("Lock Worksheets", _
                    "Unlock Worksheets")
 
    With Application.CommandBars.Add
        .Name = ToolBarName
        .Left = 200
        .Top = 200
        .Protection = msoBarNoProtection
        .Visible = True
        .Position = msoBarFloating
 
        For iCtr = LBound(MacNames) To UBound(MacNames)
            With .Controls.Add(Type:=msoControlButton)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
                .Caption = CapNamess(iCtr)
                .Style = msoButtonIconAndCaption
                .FaceId = 71 + iCtr
                .TooltipText = TipText(iCtr)
            End With
        Next iCtr
    End With
End Sub
 
'===========================================
Sub Unprotect()
    Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        Wks.Unprotect password:="password"
        Next Wks
    MsgBox "All of the WorkSheets are Now Unlocked"
End Sub
 
'===========================================
Sub Protect()
    Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        Wks.Protect password:="password"
    Next Wks
    MsgBox "All of the WorkSheets are now Locked"
End Sub