Macro para bloquear celdas después de escribir

[Darack]

Necesito por favor me pudieran ayudar ya que necesito una macro con la cual al escribir en una celda esta automáticamente pase a bloqueada para no modificar su contenido después de desplazarme a otra obviamente, el rango en que necesito realizar esto es de C3:F550. Toda la información esta en una tabla y me gustaría que la tabla no pierda sus funcionalidades de agregar la celda nueva como parte de la tabla. Adjunto archivo.

De antemano se que para que funcione debo de tener todas las celdas bloqueadas y de la misma manera proteger la hoja con contraseña.

Control Documentos.zip

[Israel Cassales]

Hola, más que tener de origen bloqueado o no, impera el orden de los eventos.

hace 3 horas, Darack dijo:

necesito una macro con la cual al escribir en una celda esta automáticamente pase a bloqueada

La macro que trae el libro ya hace algo parecido a lo que planteas, porque ya no te permite volver regresar a las celdas. Lo que no te debe estar respetando es lo que describes después:

hace 3 horas, Darack dijo:

me gustaría que la tabla no pierda sus funcionalidades de agregar la celda nueva como parte de la tabla.

Y esto ocurre porque al bloquear la hoja no puede agregar la nueva fila automáticamente con la fórmula que tienes ahí.

Entonces lo que podrías intentar es decirle a tu macro es que agregue la fila nueva (dentro de la tabla) cuando el tabulador pase por alguna columna, por ejemplo después de la F:F que es hasta donde aplica la tuya y así no modificar la que tienes original.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lo As ListObject
    Dim newRow As ListRow
    'x Elsamatilde
    'solo se controlan cambios en el rango 'desbloqueado' de antemano
    If Intersect(Target, Range("B3:F550")) Is Nothing Then Exit Sub
    'si se modifican varias celdas no se ejecuta
    If Target.Count > 1 Then Exit Sub
    'si se ingresa un dato en alguna celda del rango se bloquea
    ActiveSheet.Unprotect "Samda"
    Target.Locked = True
    'inserta una nueva fila al presionar tabulador
    If Target.Column = 6 Then 'ajusta el número de columna según sea necesario
        Set lo = ActiveSheet.ListObjects("MEMOS") 
        Set newRow = lo.ListRows.Add
        ActiveSheet.Protect "Samda"
    End If
    ActiveSheet.Protect "Samda"
End Sub

Me parece que buscas que la captura sea lineal y el usuario avance con tabulación. Si para ti está bien así, el código anterior debería ser suficiente.

¡Saludines!

Nota: Desde mi punto de vista, el orden de los eventos es un poco confuso, si llega a intentar algo diferente ojalá pudiera pasar por aquí y compartir, con gusto le podría ayudar y seguramente también algún miembro o Maestro avanzado del foro podría aportar algo adicional.

Control de Documentos Generales 2024.xlsb

[Darack]

Estimado estoy muy agradecido por la ayuda ya puse a prueba el código de la macro y me funciona tal y como yo lo imaginaba y pensaba, ahora tengo un único detalle como puedo aplicarle filtros a ese mismo archivo por ejemplo para buscar por responsable o hacia donde fue enviado.

 

Saludos.

[Israel Cassales]

En ese caso hay que indicar en el código que permita autofiltros al proteger:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lo As ListObject
    Dim newRow As ListRow
    'x Elsamatilde
    'solo se controlan cambios en el rango 'desbloqueado' de antemano
    If Intersect(Target, Range("B3:F550")) Is Nothing Then Exit Sub
    'si se modifican varias celdas no se ejecuta
    If Target.Count > 1 Then Exit Sub
    'si se ingresa un dato en alguna celda del rango se bloquea
    ActiveSheet.Unprotect "Samda"
    Target.Locked = True
    'inserta una nueva fila al presionar tabulador
    If Target.Column = 6 Then 'ajusta el número de columna según sea necesario
        Set lo = ActiveSheet.ListObjects("MEMOS") 'ajusta el nombre de la tabla según sea necesario
        Set newRow = lo.ListRows.Add
    End If
    'protege la hoja pero permite el uso de autofiltros
    ActiveSheet.Protect "Samda", UserInterfaceOnly:=True
    ActiveSheet.EnableAutoFilter = True
End Sub

 

Control de Documentos Generales 2024.xlsb