Para Dam - varias claves para el cierre

Dam siguiendo tus consejos llevo a macro de cierre asi:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Worksheets("Home").Visible = True

Sheets("Home").Select
Application.EnableEvents = True

contador = 1

If MsgBox("Desea guardar los cambios", vbQuestion & vbYesNo) = vbYes Then

Do While contador < 3

clave = InputBox("Contraseña: ")

If clave = "2012" Then

ActiveWorkbook.Save Application.EnableEvents = False

Application.DisplayAlerts = False

ActiveWorkbook.Close Application.Quit

Else

If contador < 2 Then MsgBox "Clave errónea, intente nuevamente"

contador = contador + 1

Cancel = True

Else

MsgBox "Clave errónea, se cerrará la aplicación"

Application.EnableEvents = False

Application.DisplayAlerts = False

ActiveWorkbook.Close

End If

End If

Loop

Else

Application.EnableEvents = False

Application.DisplayAlerts = False

ActiveWorkbook.Close

Application.Quit

End If

End Sub

Tengo dos dudas:

Funciona my bien pero el libro se cierra pero la aplicación no, y necesito que se cierre el excel.

Como hago para que la contraseña que ea la macro se tome de varias insertadas en un rango, o sea que cada usuario que tenga derecho a grabar utilice una contraseña especifica. Que cualquiera que la macro lea y asocie de un rango me deje guardar.

1 Respuesta

Respuesta
1

Te cambio la macro, debes crear una hoja "claves", en la columna "A" escribe las contraseñas

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'por.dam
Worksheets("Home").Visible = True
Sheets("Home").Select
Application.EnableEvents = True
contador = 1
If MsgBox("Desea guardar los cambios", vbQuestion & vbYesNo) = vbYes Then
    Do While contador < 3
        clave = InputBox("Contraseña: ")
        fila = Application.Match(Val(clave), Sheets("claves").Columns("A"), 0)
        If Not IsError(fila) Then
            ActiveWorkbook.Save
            Application.EnableEvents = False
            Application.DisplayAlerts = False
            Application.Quit
            contador = 3
        Else
            If contador < 2 Then
                MsgBox "Clave errónea, intente nuevamente"
                contador = contador + 1
                Cancel = True
            Else
                MsgBox "Clave errónea, se cerrará la aplicación"
                Application.EnableEvents = False
                Application.DisplayAlerts = False
                Application.Quit
                contador = 3
            End If
        End If
    Loop
Else
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Quit
    contador = 3
End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas