Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Macro desproteger y proteger hoja

Panchototo

Recommended Posts

Panchototo Novato

Panchototo

publicado
publicado

Buenos días,

Es mi primera intervención en el foro, soy un usuario de excel bastante avanzado pero es ahora cuando estoy descubriendo las amplias posibilidades que ofrece VBA, y en esto me estáis ayudando un montón, así que gracias!

Mi duda es: quiero hacer una macro que mediante un popup (userform) me permita desbloquear la hoja introduciendo la contraseña, y luego siga haciendo cosas con otros pupups que salen. Hasta aquí todo ok, el problema está cuando se mete la contraseña incorrecta, que se rompe la macro. Cómo podría hacer para que si se introduce una contraseña que no es correcta, entre en un loop solicitando que se introduzca la contraseña correcta, hasta que se así sea, o se cierre?

Muchísimas gracias por anticipado,

Saludos

Panchototo Novato

Panchototo

publicado
  • Autor
publicado

Perdón, me lo ha bloqueado la red del trabajo. Ahora sí subo el ejemplo.

La macro es un inputbox que me pide contraseña, desbloquea, aparece otro inputbox de selección de celda, y después otro para introducir el valor que se quiere aplicar a la celda, y vuelve a bloquear.

El problema es que si yo no meto una contraseña errónea la macro se corta. Lo que quiero es que si la contraseña es errónea (es decir, si la hoja no se desbloquea) me haga volverla a introducir, hasta que meta la contraseña correcta o cierre. Lo he intentado con un Do while, pero, en cuanto falla la contraseña, peta la macro.

A ver si me podéis ayudar, muchas gracias!

Prueba Desbloqueo.rar

tese1969 Aprendiz

tese1969

publicado
publicado

Buenas,

Prueba con esto....

Sub Botón1_Haga_clic_en()


Do While ActiveSheet.ProtectContents = True


    Dim Password

otra:

    Password = InputBox(Prompt:="Esta hoja está protegida, por favor, introduzca la contraseña", Title:="Desbloqueo de hoja")

    If Password = "" Then Exit Sub

    If Password <> "prueba" Then

    MsgBox "Contraseña incorrecta"

    GoTo otra:

    End If

    ActiveSheet.Unprotect Password

Loop[/CODE]

Dime si algo así te valdría.

Un saludo,

Tese

Panchototo Novato

Panchototo

publicado
  • Autor
publicado

Lo primero muchas gracias Tese,

Había pensado este formato, el problema que veo es que si se cambia la contraseña de la hoja, la macro deja de funcionar. Esto es importante porque es una herramienta que voy a entregar a otro departamento, y que va a pasar a su propiedad, por lo que no puedo tener control sobre ella.

Sé que he visto cómo se hace por algún lado, pero no lo he logrado encontrar.

tese1969 Aprendiz

tese1969

publicado
publicado

Si existe una contraseña, en algún sitio la tienes que incluir, ya sea en una referencia a una celda o donde consideres oportuno.

Tienes que comparar el dato que incluye el usuario con algo. En cualquier aplicación o en cualquier web la comparación la haces contra una base de datos, pero aquí no dispones de ella.

Un saludo,

Tese

tese1969 Aprendiz

tese1969

publicado
publicado

Inténtalo así:

Sub Botón1_Haga_clic_en()



Do While ActiveSheet.ProtectContents = True


    Dim Password

GoTo prim:

otra:

MsgBox "Contraseña incorrecta"

prim:

    Password = InputBox(Prompt:="Esta hoja está protegida, por favor, introduzca la contraseña", Title:="Desbloqueo de hoja")

    If Password = "" Then Exit Sub

  On Error GoTo otra:


    ActiveSheet.Unprotect Password



Loop[/CODE]

Se intenta utilizar el error que se produce al incluir una contraseña errónea para volver a iniciarlo.

De esta manera la contraseña puede ser cualquiera.

Ya me contarás...

Un saludo,

Tese

  • 3 weeks later...
NestorPinto Novato

NestorPinto

publicado
publicado

Intenta con este (Usuario Experto )

Private Sub CommandButton1_Click()

On Error GoTo Errorusuario

For I = 2 To R

a = Sheets(2).Cells(I, 1)

b = Sheets(2).Cells(I, 2)

If a = ComboBox1 And b = TextBox1 Then

Sheets(1).Range("A10") = ComboBox1

Sheets(1).Range("B10") = TextBox1

UserForm1.Hide

Exit Sub

End If

Next

Errorusuario:

RESPUESTA = MsgBox("CONTRASEÑA INVALIDA DESEA VOLVER A INTENTAR", vbOKCancel, "CONTRASEÑA INVALIDA")

If RESPUESTA = 2 Then

ActiveWorkbook.Close (False)

ComboBox1.Text = ""

TextBox1.Text = ""

End If

End Sub

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Adjunto excel CONTADOR FINAL.xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      Prueba y comenta 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.