Boa tarde!!

Eu não sei ao certo, mas pense em algo assim...

Option Explicit
Sub AleVBA_11256()
    Dim Open_Password As String
    Dim New_File_Name As String
    New_File_Name = Range("G2").Value & "" & Range("G1").Value & ".xlsm"
    Open_Password = InputBox("Por favor, digite uma senha para impedir os outros de editar o seu arquivo. Você deve lembrar da SENHA")
    ActiveWorkbook.SaveAs New_File_Name, _
    WriteResPassword:=Open_Password, _
    Password:="heather"
     
     
End Sub

Boa tarde!!

Tente esse também.
Cole o código dentro do Editor VB, no módulo da pasta de trabalho, em Esta_Pasta_de_Trabalho

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Const PW As String = "AleVBA"
    Dim EnterPW As String

    EnterPW = InputBox("Digite a senha para salvar")

    If PW = Empty Then Exit Sub
    If EnterPW = PW Then
        ThisWorkbook.Save
    Else: Cancel = True
    End If

End Sub

Att

oi . funcionou. fiz apenas algumas modificações.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Senha As String
Senha = "34435vrb"

If InputBox("Digite a senha para Salvar", "Proteção - Contabilidade") = Senha Then
Exit Sub
Else
If SaveAsUI = True Then
MsgBox "Não é permitido Salvar Como"
Cancel = True
Exit Sub
End If
If SaveAsUI = False Then
MsgBox "Não é permitido ‘Salvar"
Cancel = True
Exit Sub
End If
End If
End Sub

entretanto quando coloco a senha, ela aprece exatamente como se escreve, não tem como deixar o asterisco (*)?

Boa tarde!!

A duas formas, uma é usar um Userfom com uma caixa de texto a outra configurar via VBA a InputBox, possível mas na minha opinião, não é tão necessário.

As duas formas podem ser encontradas usando a pesquisa do fórum!

Att