Macro que bloquee celdas después editadas al cerrar archivo, manteniendo algunas bloqueadas siempre y desbloqueadas otras.

Dante Amor, hace un tiempo me ayudó con una macro que bloqueaba celdas después de editarlas. Pero no me está funcionando bien. Le envié un correo en esa ocasión con el archivo.

Requiero que siempre estén bloqueadas A:B, Z:AD

Que se bloqueen después de editar y al cerrar archivo. C:P, Y

Que siempre estén desbloqueadas Q:X

En esa ocasión me respondió con esta macro que cito a continuación, pero no me funciona como requiero. De antemano gracias.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Set h = Sheets("Hoja1")
    pwd = "abc"
    h.Unprotect pwd
    h.Cells.SpecialCells(xlCellTypeConstants, 23).Locked = True
    h.Cells.SpecialCells(xlCellTypeFormulas, 23).Locked = True
    h.Protect pwd, False, True, False, True, True, _
        True, True, True, True, True, True, True, True, True
    h.EnableSelection = xlNoRestrictions
    ActiveWorkbook.Save
End Sub

1 respuesta

Respuesta
1

H o l a:

Antes de poner en ejecución las macros tienes que bloquear y desbloquear las columnas según lo requieras, para eso:

  • Desprotege la hoja
  • Selecciona todas las celdas
  • En formato de celdas, Proteger desactivar Bloqueada, Aceptar
  • Si tienes celdas combinadas, quita la combinación.
  • Ahora selecciona las columnas A:B
  • Cambia el formato de las columna A:B, Proteger, Activar Bloqueda.
  • Ahora selecciona las columnas Z:AD
  • Cambia el formato de las columnas Z:AD, Proteger, Activar Bloqueada.
  • Vuelve a combinar las celdas que requieras.

Ya que tu hoja está con la configuración de tus columnas, entonces pon la siguiente macro en los eventos de tu hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Not Intersect(Target, Range("C:P,Y:Y")) Is Nothing Then
        pwd = "abc"
        ActiveSheet.Unprotect pwd
        For Each c In Target
            c.Locked = True
        Next
        ActiveSheet.Protect pwd, False, True, False, True, True, _
            True, True, True, True, True, True, True, True, True
        ActiveSheet.EnableSelection = xlNoRestrictions
    End If
End Sub

Sigue las Instrucciones para poner la macro en los eventos de worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro

Ahora pon la siguiente macro en los eventos de tu libro:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    On Error Resume Next
    Set h = Sheets("Hoja1")
    pwd = "abc"
    h.Unprotect pwd
    h.Range("C:P, Y:Y").SpecialCells(xlCellTypeConstants, 23).Locked = True
    h.Range("C:P, Y:Y").SpecialCells(xlCellTypeFormulas, 23).Locked = True
    h.Protect pwd, False, True, False, True, True, True, _
        True, True, True, True, True, True, True, True
    h.EnableSelection = xlNoRestrictions
    ActiveWorkbook.Save
End Sub

Instrucciones para poner la macro en los eventos ThisWorkbook

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
  4. Del lado derecho copia la macro

Prueba el funcionamiento y me comentas.


:) 
:) 

Dante Amor te agradezco muchísimo tu atención. La he probado. Le pido disculpas al no haber sido lo suficientemente explícito. Requiero que el bloqueo de las celdas antes mencionadas se realice hasta que se cierre el archivo, es decir, se bloqueen las celdas editadas del rango especificado y se guarde el archivo al cerrarlo. 

Mil gracias de nuevo Dante Amor. Me has ayudado mucho, y disculpa que no haya sido suficientemente claro desde el inicio. 

Quedo atento a tus comentarios.

Saludos

Quita esta macro de tu libro y sigue todo el procedimiento que te puse, paso a paso.

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Not Intersect(Target, Range("C:P,Y:Y")) Is Nothing Then
        pwd = "abc"
        ActiveSheet.Unprotect pwd
        For Each c In Target
            c.Locked = True
        Next
        ActiveSheet.Protect pwd, False, True, False, True, True, _
            True, True, True, True, True, True, True, True, True
        ActiveSheet.EnableSelection = xlNoRestrictions
    End If
End Sub

Quito la macro de la hoja? (la primera) y dejo solo la segunda en el Libro? Más específico, coloco la siguiente en Thisworkbook? Perdón pero no me funciona :( No bloquea las que edito, si bloquea las que puse en formato de celda "bloqueada" al inicio. y si guarda los cambios. pero no bloquea las modificaciones. Muchas Gracias Dante Amor.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    On Error Resume Next
    Set h = Sheets("Hoja1")
    pwd = "abc"
    h.Unprotect pwd
    h.Range("C:P, Y:Y").SpecialCells(xlCellTypeConstants, 23).Locked = True
    h.Range("C:P, Y:Y").SpecialCells(xlCellTypeFormulas, 23).Locked = True
    h.Protect pwd, False, True, False, True, True, True, _
        True, True, True, True, True, True, True, True
    h.EnableSelection = xlNoRestrictions
    ActiveWorkbook.Save
End Sub

Antes de la macro tienes que configurar la hoja.

Envíame tu archivo con la macro para configurar tu hoja.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Eder Sinner” y el título de esta pregunta.

Dante Amor, te he enviado el archivo.

Quedo atento a tus comentarios. 

Gracias. ☺

No me llegó, puedes revisar el correo.

Ya lo volví a enviar. Pesa 5mb, será por eso?

Ya quedó, solamente pon esta macro en los eventos de thisworkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Set h = Sheets("SUBDELEGACIÓN 1 LOCALES")
    pwd = "success"
    h.Unprotect pwd
    h.Range("C4:P10003,Y4:Y10003").SpecialCells(xlCellTypeConstants, 23).Locked = True
    On Error Resume Next
    h.Range("C4:P10003,Y4:Y10003").SpecialCells(xlCellTypeFormulas, 23).Locked = True
    On Error GoTo 0
    h.Protect pwd, False, True, False, True, True, True, True, _
                   True, True, True, True, True, True, True
    h.EnableSelection = xlNoRestrictions
    ActiveWorkbook.Save
End Sub

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)R ecuerda valorar la respuesta. G r a c i a s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas