0
If Me.boxPassword.Value = "12345" Then

    Unload Me
    Sheets("Configuração").Visible = True
    Sheets("Configuração").Select

Else
    Me.Hide
    Retry = MsgBox("Passe incorreta, Tentar outra vez?", vbYesNo, "Retry?")

    Select Case Retry
        Case Is = vbYes
            Me.boxPassword.Value = ""
            Me.boxPassword.SetFocus
            Me.Show

        Case Is = vbNo
            Unload Me

    End Select
End If

Isto está funcional, o que eu queria agora era saber como poder ter um metodo que me permitisse alterar a password para outra qualquer

2 Respostas 2

0

Pela pesquisa que eu fiz parece que a única forma de alterar a senha de uma planilha é salvando ela com o método Workbook.SaveAs():

' Usando o parâmetro 'Password' o arquivo só poderá ser aberto com a senha. 
Workbooks(1).SaveAs Password:="[nova_senha]"

' Usando o parâmetro 'WriteResPassword', se a senha não for informada o arquivo
' não será poderá ser editado, mas será aberto como somente leitura.
Workbooks(1).SaveAs WriteResPassword:="[nova_senha]"

Fontes:

VBA Code to Password Protect an Excel file - Excel off the grid
Setting password on Excel files using VBA - Stack Overflow
Workbook.SaveAs Method (Excel) | Microsoft Docs

0

Caso voce esteja tentando criar seu proprio sistema de login na planilha tem um codigo que talvez possa te ajudar que eu uso.

Crie um objeto do tipo Classe e cole as informações abaixo:

Private Const vShtUsersName As String = "auxUsers"
Private Const vShtTableName As String = "tblSecUsers"
Private Const vAdminName As String = "Admin"
Private Const vAdminDefaulPassValue = "admin"
Private vShtUsers As Worksheet
Private oDicUsers As Object
Private oTable As ListObject

Private Sub Class_Initialize()

    If Not fWorksheetExists(vShtUsersName, ThisWorkbook) Then
        ThisWorkbook.Sheets.Add().Name = vShtUsersName
    End If
    Set vShtUsers = ThisWorkbook.Sheets(vShtUsersName)

    If Not fObjectExists(vShtTableName, vShtUsers) Then
        vShtUsers.Range("A1").Value = "User"
        vShtUsers.Range("B1").Value = "Password"
        vShtUsers.ListObjects.Add(xlSrcRange, vShtUsers.Range("A1:B2"), , xlYes).Name = vShtTableName
    End If
    Set oTable = vShtUsers.ListObjects(vShtTableName)
    sLoad
End Sub

Private Function fWorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    fWorksheetExists = Not sht Is Nothing
End Function

Private Function fObjectExists(ObjName As String, sh As Worksheet) As Boolean
Dim vObject As Variant
    On Error Resume Next
    Set vObject = sh.ListObjects(ObjName)
    On Error GoTo 0
    fObjectExists = Not IsEmpty(vObject)
End Function

Private Sub sLoad()
Dim vArryValues As Variant
Dim i As Long

    Set oDicUsers = CreateObject("Scripting.Dictionary")

    vArryValues = oTable.DataBodyRange.Value

    With oTable.DataBodyRange

        If vArryValues(1, 1) = vbNullString Then
            .Cells(1, 1).Value = vAdminName
            .Cells(1, 2).Value = vAdminDefaulPassValue
        End If

        For i = 1 To UBound(oTable.DataBodyRange.Value, 2) - 1
            oDicUsers.Add .Cells(i, 1).Value, .Cells(i, 2)
        Next i

    End With

End Sub

Public Sub Add(pUserName As String, pPass As String)
Dim vNewRow As ListRow
    If pUserName = vbNullString Then
        MsgBox "Erro, usuario não pode estar em branco"
        Exit Sub
    End If
    Set vNewRow = oTable.ListRows.Add
    vNewRow.Range(1, 1) = pUserName
    vNewRow.Range(1, 2) = pPass
    sLoad
End Sub

Public Sub ChangePassword(pUser As String, pActivePass As String, pNewPass As String)
    If Not (oDicUsers(pUser).Value = pActivePass) Then
        MsgBox "Usuario/Senha invalidos"
        Exit Sub
    End If

    oDicUsers(pUser).Value = pNewPass
    sLoad

End Sub

Public Function ValidAccess(pUser As String, pPass As String) As Boolean
    ValidAccess = (oDicUsers(pUser).Value = pPass)
End Function

Depois salve o objeto como: clsUserSecurity

Depois voce pode usar ele da seguinte forma:

Public Sub teste()

    Dim oUSec As New clsUserSecurity

    Debug.Print oUSec.ValidAccess("Admin", "admin")

    If oUSec.ValidAccess("Admin", "admin") Then
        oUSec.ChangePassword "Admin", "admin", "hud"
    End If

    Debug.Print oUSec.ValidAccess("Admin", "hud")

End Sub

Voce pode usar o codigo como preferir. Note que este objeto vai criar sozinho sua propria Sheet para gerir usuarios e senhas. Mas voce pode fazer as alterações para manipular até algum tipo de nivel de acesso se assim prefirir.

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .