Desproteger un rango de celdas en una hoja protegida
Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si no no funciona y al final de la macro el Protect, pero aún que lo tengo puesto así
ActiveSheet. Protect "hola"
Pero solo activa las del rango de la macro, en vez de hacerlo al revés, la macro se activa cuando cliclas de la columna A a la F y las filas a partir de la 5 y en la G y la H es donde están las fórmulas,
'Worksheets("Sheet1").Range("A5:F1000").Locked = False
ActiveSheet.Unprotect "hola"
'Hoja1.Range(A5, F1000).Unprotect "hola"
'UserInterfaceOnly = True
With Anterior
.ClearComments
.Interior.ColorIndex = xlNone
.Font.Bold = False
.Font.Italic = False
'.Protect "hola"
End With
' With Not Anterior
' .Protect "hola"
If Cells(1, Target.Column) = "" Or Target.Row < 5 Or Target.Column > 6 Then Exit Sub
Aviso = "Aquí ponle "
With Target(1, 1)
If Not .Value = "" Then Aviso = "Modifique "
.ClearComments
.AddComment
.Comment.Visible = True
.Comment.Text Text:=Aviso & Cells(1, Target.Column)
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Shape.IncrementTop ActiveCell.Height * -1
.Comment.Shape.IncrementLeft ActiveCell.Height
.Interior.Color = Gris
.Font.Bold = True
.Font.Italic = True
ActiveSheet.Protect "hola"
'Hoja1.Protect "hola"
'Hoja1.Range(G5, H1000).Protect "hola"
'If Target.Column > 6 Then .Select.Protect "hola"
Set Anterior = Target
End With
'ActiveSheet.Protect "hola"
He separado las fórmulas que he probado y no han funcionado para que os sea practico verlo
4 Respuestas
Aquí tenés 2 eventos:
1 - uno al seleccionar la celda del rango (debe asignar formatos especiales)
2- Al modificar la celda introduciendo o modificando una celda del rango.
Por lo tanto en el primer evento NO debieras bloquear nuevamente (para permitir el cambio) sino recién al seleccionar alguna celda fuera del rango (*). Y también al salir del evento Change.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'solo se controla el rango A5:F10, desde cualquier otra celda se vuelve a bloquear
If Intersect(Target, Range("A5:F10")) Is Nothing Then
'se vuelve a bloquear el rango y proteger la hoja
With ActiveSheet
.Range("A5:F1000").Locked = True
.Protect "hola"
End With
Exit Sub
End If
Resaltar Target
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A5:F10")) Is Nothing Then Exit Sub
'se vuelve a bloquear el rango y proteger la hoja
With ActiveSheet
.Range("A5:F1000").Locked = True
.Protect "hola"
End With
End Sub(*) Esto lo incorporé notando que si seleccionas la celda de la col F pero no ingresas ningún valor, al pasar a la col G se encuentra desbloqueada.
Y en el módulo donde tenías la macro Resaltar, quedaría así:
Const Gris As Long = 13553360
Public Anterior As Range
Dim Aviso As String
Sub Resaltar(Target As Range)
'ajustada x Elsamatilde
On Error Resume Next
Application.ScreenUpdating = False
'ya sabemos que estamos en el rango correcto
'se desprotege la hoja activa para desbloquear celdas en rango de datos
With ActiveSheet
.Unprotect "hola"
.Range("A5:F1000").Locked = False
End With
'se quitan formatos al rango anterior
With Anterior
.ClearComments
.Interior.ColorIndex = xlNone
.Font.Bold = False
.Font.Italic = False
End With
Aviso = "Aquí ponle "
With Target(1, 1)
If Not .Value = "" Then Aviso = "Modifique "
.ClearComments
.AddComment
.Comment.Visible = True
.Comment.Text Text:=Aviso & Cells(1, Target.Column)
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Shape.IncrementTop ActiveCell.Height * -1
.Comment.Shape.IncrementLeft ActiveCell.Height
.Interior.Color = Gris
.Font.Bold = True
.Font.Italic = True
End With
'se guarda la referencia de la celda modificada
Set Anterior = Target
End Sub
Sdos. En videos 45 al 47 podrás encontrar explicaciones a los principales eventos de hojas.
En las macros de los eventos debes ajustar el rango a tu modelo, yo utilicé solamente A5:F10.
Sdos!
Olvidé un detalle.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'solo se controla el rango A5:F10, desde cualquier otra celda se vuelve a bloquear
If Intersect(Target, Range("A5:F10")) Is Nothing Then
'se vuelve a bloquear el rango y proteger la hoja
With ActiveSheet
.Unprotect "hola"
.Range("A5:F1000").Locked = True
.Protect "hola"
End With
Exit Sub
End If
Resaltar Target
End SubSdos!
Trata de evitar activar y desactivar la protección de la hoja múltiples veces dentro de la macro. Intenta hacer todas las mapquest operaciones necesarias primero y luego protege la hoja al final.
¿Have you ever had trouble trying to find your way while driving? Try this, it will help you mapquest driving directions
Unlock password-protected devices. The steps to follow are: Open your Excel file and select the cells you want to alter again. Unlock password-protected devices. The steps to follow are: Open your Excel file and select the cells you want to alter again. Papa's Games