Macro para Evitar borrar contenido de celdas
Tengo una hoja de calculo, que debido a que tiene ya macros configuradas, no se puede accesar a la acción de deshacer. Una vez ingresado un dato, no se puede deshacer, pero si se puede eliminar. Quiero saber si existe alguna posibilidad a través de macros, de hacer que una vez introducido el texto, al darle enter, ¿ya no se pueda "suprimir" la información de las celdas?
2 Respuestas
Te anexo el código para desproteger la hoja, bloquear las celdas modificadas y volver proteger la hoja para que no se pueden modificar los datos.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
clave = "abc"
'
If Not Intersect(Target, Range("A:E, G:G")) Is Nothing Then
ActiveSheet.Unprotect clave
Application.ScreenUpdating = False
Application.EnableEvents = False
'
For Each c In Target
Range("H2:I2").Copy Cells(c.Row, "H")
Next
'
u = Range("A" & Rows.Count).End(xlUp).Row
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B2:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("D2:D" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("E2:E" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:I" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
an1 = Cells(2, "B")
an2 = Cells(2, "D")
an3 = Cells(2, "E")
con = 0
For i = 2 To u
If an1 = Cells(i, "B") And _
an2 = Cells(i, "D") And _
an3 = Cells(i, "E") Then
con = con + 1
Else
con = 1
End If
Cells(i, "F") = con
an1 = Cells(i, "B")
an2 = Cells(i, "D")
an3 = Cells(i, "E")
Next
'
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2:A" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:I" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Range("A" & Target.Row & ":I" & Target.Row).Locked = True
End If
'
ActiveSheet.Protect clave, DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
'
Application.EnableEvents = True
End If
End SubTambién te envié el archivo para que lo pruebes, solamente cuando cambias el dato de la columna G se protegen las celdas de las columnas A a la I.
Esta perfecto...
Solo te quiero pedir de favor, si me lo puedes cambiar a que al capturar el dato en la columna E se bloqueen y el Status que esta en la columna G si se pueda modificar, es decir, que la columna G no este protegida
Cambia en la macro
Esto:
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Range("A" & Target.Row & ":I" & Target.Row).Locked = True
End If
por esto
If Not Intersect(Target, Range("E:E")) Is Nothing Then
Range("A" & Target.Row & ":E" & Target.Row).Locked = True
End If
¡Gracias!
Listo! Muy amable!
Te agradezco mucho de verdad tu pronta respuesta y atención
Un favor, están protegidas las celdas hasta la A18.
Me la puedes enviar "en blanco" para que comiencen en la celda A2?
Solamente desprotege la hoja, cambia el formato de las celdas, en la pestaña Proteger y desmarca la casilla Bloqueada
Para evitar suprimir el contenido de la celda, te recomiendo que investigues la parte de protección de hojas, que justamente hace lo que necesitás