Agregar asteriscos en msgbox de contraseña

[Shereffa]

Hola comunidad!!

En esta oportunidad les traigo un problema que tengo hace rato!

Actualmente tengo una planilla que tiene 4 botones, para que corran debes ingresar una contraseña. La misma esta a la vista, es decir, no puedo colocar asteriscos en lugar de las letras. Por lo que estuve leyendo, con el metodo que utilizo para colocar la contraseña, no me permite. La verdad quise cambiarlo pero no puedo, no me sale.

Alguien me podria dar una mano?

Es decir, necesito que cuando acciono el boton, salte un msgbox solicitando contraseña pero que la misma no se vea cuando la escribo.

Copio una parte del codigo que utiliza este metodo de contraseña;

 

Private Sub Descontar_Click()

Application.ScreenUpdating = False

If (InputBox("Introduzca la contraseña adecuada", "Atención") <> "Pacheco.") Then
    Call MsgBox("Contraseña incorrecta", vbCritical Or vbDefaultButton1, "Atención")
    Exit Sub
End If
    'Desproteger la Hoja
    Worksheets("Stock").Unprotect "Pacheco."
    Range("L11:L500").Select
    Selection.Copy
    ActiveCell.Offset(0, -4).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J11:J500").Select
    Selection.ClearContents
    
    Worksheets("Stock").Range("J10:J500").Locked = False
    Worksheets("Stock").Range("N10:N500").Locked = False
    Worksheets("Stock").Range("M2:Q3").Locked = False
    Worksheets("Stock").Range("S2:U10").Locked = False
    Range("J10").Select

    'Proteger la Hoja
    Worksheets("Stock").Protect Password:="Pacheco.", DrawingObjects:=False, Contents:=True, Scenarios:=False, _
    UserInterfaceOnly:=False, AllowFormattingCells:=False, AllowFormattingColumns:=False, _
    AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, _
    AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, _
    AllowSorting:=False, AllowFiltering:=True, AllowUsingPivotTables:=False
    
Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveWorkbook.Save

End Sub

[Antoni]

Prueba el adjunto.

 

Contraseña.xlsm

[Shereffa]

Antoni, gracias por el aporte!! 

Lo edite un poco a mis necesidades, pero me sirvio!

Gracias como siempre!