Usuarios con privilegios de insertar, eliminar y cambiar nombre a hojas en Excel usando macros VBA

Definir en Excel usuarios con privilegios de insertar, eliminar y cambiar nombre a hojas u

En este tutorial les mostraré cómo podemos usar una macro con código VBA para definir si ciertos usuarios tienen privilegios para modificar la estructura de un archivo de Excel, sobre todo si se tienen privilegios para modificar lo referente a las hojas de un archivo de Excel:

  • Insertar hojas.
  • Eliminar hojas.
  • Cambiar nombre a hojas.
  • Mover hojas a otro archivo.
  • Proteger hoja.
  • Ocultar y mostrar hojas.

Proteger libro

La opción de la página Revisar > Proteger libro nos permite proteger la estructura de un archivo de Excel para no modificar las hojas que contiene un archivo de Excel. De manera opcional podemos asignar una contraseña.

Proteger libro para no modificar la estructura de las hojas.

Figura 1. Proteger libro para no modificar la estructura de las hojas.

Ver video Usuarios con privilegios para modificar estructura de un archivo de Excel

Suscríbete al canal de EXCELeINFO en YouTube para aprender más de Excel y macros.

Tabla de usuarios y Formulario de usuario y contraseña

Tenemos una Tabla donde contenemos el dato de usuarios, contraseñas y un campo que definimos como Modificar estructura para asignar un permiso a los usuarios de poder modificar la estructura de un archivo. Además contamos con un Formulario donde ingresamos un usuario y contraseña. Una vez que se validan los datos, se protege la estructura del archivo en caso de que en la Tabla de usuarios tenga el permiso.

Usuario y contraseña para definir si un usuario tiene privilegios de modificar un archivo.

Figura 2. Usuario y contraseña para definir si un usuario tiene privilegios de modificar un archivo.

Código VBA de la macro

En el siguiente código VBA definimos dos eventos, Workbook_Open para ejecutar una macro al abrir el archivo de Excel y Workbook_BeforeClose para ejecutar una macro al cerrar el archivo de Excel.

'EXCELeINFO
'MVP Sergio Alejandro Campos
'http://www.exceleinfo.com
'https://www.youtube.com/user/sergioacamposh
'http://blogs.itpro.es/exceleinfo

Private Sub Workbook_BeforeClose(Cancel As Boolean)

ThisWorkbook.Save

ActiveWorkbook.Protect psw, Structure:=True, Windows:=False

End Sub

Private Sub Workbook_Open()

ActiveWorkbook.Protect psw, Structure:=True, Windows:=False

UserForm1.Show

End Sub

El siguiente es el código VBA del formulario,

Option Explicit
'
'EXCELeINFO
'MVP Sergio Alejandro Campos
'http://www.exceleinfo.com
'https://www.youtube.com/user/sergioacamposh
'http://blogs.itpro.es/exceleinfo
'

'Al iniciar el formulario
Private Sub UserForm_Initialize()
FormDesign.FormDesign
End Sub
'
'Botón Cerrar
Private Sub CommandButton1_Click()
Unload Me
End Sub

'Botón Validar
Private Sub CommandButton2_Click()
Dim usuario As String
Dim Contrasenia As Variant
Dim UsuarioExistente
Dim DatoEncontrado
Dim Rango As Range
Dim ModificarEstructura As String

UsuarioExistente = Application.WorksheetFunction.CountIf(Sheets("usuarios").Range("B:B"), Me.txtUsuario.Value)

Set Rango = Sheets("usuarios").Range("B:B")

'Validamos que se hayan introducido valores.
If Me.txtUsuario.Value = "" Or Me.txtPassword.Value = "" Then
    MsgBox "Por favor introduce usuario y contraseña", vbExclamation, "EXCELeINFO"
    Me.txtUsuario.SetFocus
    
    'Se valida que el usuario exista en la tabla.
ElseIf UsuarioExistente = 0 Then
    MsgBox "El usuario '" & Me.txtUsuario & "' no existe", vbExclamation, "EXCELeINFO"
    
    'En caso de que el usuario exista, validamos su contraseña.
ElseIf UsuarioExistente = 1 Then
    DatoEncontrado = Rango.Find(What:=Me.txtUsuario.Value, MatchCase:=False, LookAt:=xlWhole).Address
    Contrasenia = CStr(Usuarios.Range(DatoEncontrado).Offset(0, 1).Value)
    
    'Si el usuario y la contraseña coinciden...
    If LCase(CStr(Usuarios.Range(DatoEncontrado).Value)) = LCase(Me.txtUsuario.Value) And Contrasenia = _
        Me.txtPassword.Value Then
        
        'En caso de que el usuario y la contraseña sean correctos
        '''''''''''''''''''''''''''''''''''''''''''''
        'Definimos si el usuario tiene privilegios para modificar la estructura de las hojas
        ModificarEstructura = Usuarios.Range(DatoEncontrado).Offset(0, 2).Value
        
        If ModificarEstructura = "NO" Then
            ActiveWorkbook.Protect psw, Structure:=True, Windows:=False
        ElseIf ModificarEstructura = "SI" Then
            ActiveWorkbook.Unprotect Password:=psw
        End If
        
        '''''''''''''''''''''''''''''''''''''''''''''
        Unload Me
        
    Else
        
        MsgBox "La contraseña es inválida", vbExclamation, "EXCELeINFO"
    End If
End If
    
End Sub

Descarga el archivo de ejemplo

Permitir acciones a usuarios PROTEGER.zip

Si te gustó este tutorial por favor regístrate en nuestra Lista de correo y Suscríbete a nuestro canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.

You may also like...