Macro para acceso a determinadas hojas

Tengo unlibro en el cual se controla adecuadamente el acceso al mismo dependendo si el usuario esta inscrito en el mismo y además si esta habilitado. Ademas queda el registro histórico de los ingresos con fecha y hora, pero necesito encontrar la manera parq eu cada usuario vaya a determinada hoja, esta deb estar oculta (Worksheets("XXXXXX"). Visible = xlSheetVeryHidden), asi que después de seleccionar su usuario, digitar su contraseña no solo le permite el acceso sino que llama a esta hoja exclusiva para él. Tengo las siguientes macros de control:

Sub Entrada()
    Application.ScreenUpdating = False
nombre = Application.VLookup(Sheets("Control").Range("A2"), Sheets("Control").Range("B:C"), 2, 0)
clave = Application.VLookup(nombre, Sheets("Claves").Range("B:D"), 3, 0)
If clave = Sheets("Home").Range("I14") Then
    autorizado = Application.VLookup(nombre, Sheets("Claves").Range("B:E"), 4, 0)
    If autorizado = "" Then
        MsgBox "Usuario no autorizado", vbCritical, "INICIO"
    Else
        Sheets("Home").Select
        Range("I14").Select
        Selection.Copy
        Worksheets("Control").Visible = True
        Sheets("Control").Select
        Range("K2").Select
        ActiveSheet.Paste
        Worksheets("Entrada").Visible = True
        Sheets("Entrada").Select
        ActiveSheet.Unprotect Password:="2012"
        Range("A3:D3").Select
        Selection.Insert Shift:=xlDown
        Sheets("Control").Select
        Range("I2:L2").Select
        Selection.Copy
        Sheets("Entrada").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="2012"
        Sheets("Home").Select
        ActiveSheet.Unprotect Password:="2012"
        Range("I14").Select
        Selection.ClearContents
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="2012"
        Worksheets("Inicio").Visible = True
        Sheets("Inicio").Select
    End If
Else
    MsgBox "La clave o el nombre no estan registrados", vbCritical, "INICIO"
End If

    Worksheets("Control").Visible = xlSheetVeryHidden
    Worksheets("Entrada").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True
End Sub
Sub EntradaDatos()
    Entrada1 = InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Introduzca su clave numerica", "Registro por clave numerica", "Ingrese número natural, sin puntos ni comas", 4000, 3000)
    If Entrada1 = "Ingrese número natural, sin puntos ni comas" Then Entrada1 = ""
    ActiveSheet.Unprotect Password:="2012"
    Sheets("Home").Range("I14") = Entrada1
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="2012"
End Sub

Puedo compartir el libro para que el Experto que este en capacidad de darme una mano entienda mejor la necesidad.

1 respuesta

Respuesta
1

Envíame tu archivo, me explicas cuál hoja le pertenece a cada usuario.

Dante buenos días, ya te remití el correo con algunas explicaciones adicionales.

Hay que realizar varias macros.

En los eventos de la hoja "home"

Private Sub Worksheet_Activate()
'Por.Dante Amor
    For Each h In Sheets
        If h.Name <> "Home" Then
            h.Visible = xlSheetVeryHidden
        End If
    Next
End Sub

En los eventos de workbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    For Each h In Sheets
        If h.Name <> "Home" Then
            h.Visible = xlSheetVeryHidden
        End If
    Next
    ActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()
'Por.Dante Amor
    For Each h In Sheets
        If h.Name <> "Home" Then
            h.Visible = xlSheetVeryHidden
        End If
    Next
End Sub

Los cambios a la macro del módulo

Sub EntradaDatos()
'Act.Por.Dante Amor
    Entrada1 = InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Introduzca su clave numerica", "Registro por clave numerica", "Ingrese número natural, sin puntos ni comas", 4000, 3000)
    If Entrada1 = "Ingrese número natural, sin puntos ni comas" Then Entrada1 = ""
    'ActiveSheet.Unprotect Password:="2012"
    'Sheets("Home").Range("I14") = Entrada1
    'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="2012"
    Set h1 = Sheets("Home")
    Set h2 = Sheets("Claves")
    If IsNumeric(Entrada1) Then Entrada1 = Val(Entrada1)
    For i = 1 To h2.Range("B" & Rows.Count).End(xlUp).Row
        f = h1.DrawingObjects("Drop down 5").Value
        If h2.Cells(i, "B") = h2.Cells(f, "B") And _
           h2.Cells(i, "D") = Entrada1 Then
           hoja = h2.Cells(i, "E")
           existe = True
           Exit For
        End If
    Next
    '
    If existe Then
        Sheets(hoja).Visible = -1
        Sheets(hoja).Select
    Else
        MsgBox "El usuario o la clave no existen"
    End If
End Sub

Revisa el funcionamiento

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

No puedo filtrar

Gustavo como esta me colabora con los siguiente: tengo una macro que usted me ayudo la vez pasado : Private Sub Worksheet_Change(ByVal Target As Range) Application.MoveAfterReturn = False If Target.Count = 1 Then If (Target.Column = 14 And Target <>...
1 respuesta

Macro de autofiltros/oculte de columnas con celdas bloqueadas

Tengo una planilla con muchas macros que ejecutan autofiltros y oculte de columnas. Y necesito bloquear celdas luego de que se ingresen valores. El tema que cuando bloqueo las celdas tengo conflicto con la ejecución de las macros. Supongo porque...
1 respuesta

Ejecutar una macro dependiendo de otra macro?

Tengo una pequeña duda... Tengo dos botones con macros uno de ellos dice IMPRIMIR y otro dice REPARTO.. Lo que quiero es que no se pueda ejecutar el botón REPARTO si no se ha impreso nada osea si no le han dado clic al botón IMPRIMIR... En el botón...
2 respuestas

Macro para bloquear celdas escritas en Excel

Tengo la siguiente macro, pero yo quiero que solo se aplique a la Hoja1. ¿Es posible? Private Sub Workbook_BeforePrint(Cancel As Boolean) 'Proteger celdas con información 'Por.Dam Application.ScreenUpdating = False ActiveSheet.Unprotect...
2 respuestas

Excel macro proteger hoja con contraseña y autofiltro disponible

A tod@s l@s expert@s y gracias por anticipado por vuestra ayuda. Tengo una hoja protegida con varios macros que la desprotegen al empezar a correr y la protegen al finalizar. Necesito que en estas hojas protegidas un usuario normal pueda seleccionar...
1 respuesta

Proteger celdas en excel

Tengo una hoja de excel que quiero que una columna una vez escrito un valor o dato en cada celda de esa columna no se pueda modificar, o que avise pidiendo permiso. No se si esto se puede hacer, sino a ver si hay alguna alternativa similar.
1 respuesta