Agregar dos funciones a esta macro

A partir de esta línea:

IF r Locked = False Then

   r.Interior.Color = RGB(255, 255, 255)
   r.Font.Color = RGB(0, 0, 0)

    r.ClearContents 

End IF

Evalúa si vas a mantener la de ClearContents o no.

Sdos.

Elsa

Me da error de compilación

Un saludo

Seguramente es en esta línea (falta el punto):

IF r.Locked = False Then

Sdos!

La línea anterior que tenías la tenés que reemplazar por todas las que te pasé (colocando el punto ;)

If r.Locked = False Then r.ClearContents

No me hace nada.

Un saludo

Ah, que claro.

Copia la macro para que yo pueda ver como colocaste las instrucciones.

Sdos!

Gracia Elsa

Sub BorrarDesbloqueadas()
ActiveSheet.Protect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then
r.Interior.Color = RGB(255, 255, 255)
r.Font.Color = RGB(0, 0, 0)
r.ClearContents
End If
Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
If Not Application.Intersect(img.TopLeftCell, Selection) Is Nothing Then
If img.Type = msoPicture Then img.Delete
End If
Next
Next
End Sub

Un saludo

Primero las aclaraciones y luego el código:

Estás 'protegiendo' la hoja ... y luego tratas de modificarla.

Luego estás trabajando en un bucle dentro del otro bucle. Debieras dar formato a las celdas (1er bucle) y luego trabajar con los shapes que están 'por encima' de las celdas por lo tanto no las afecta (2do bucle)

Sub BorrarDesbloqueadas()
ActiveSheet.UnProtect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then
r.Interior.Color = RGB(255, 255, 255)
r.Font.Color = RGB(0, 0, 0)
r.ClearContents
End If
Next
Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
If Not Application.Intersect(img.TopLeftCell, Selection) Is Nothing Then
If img.Type = msoPicture Then img.Delete
End If
Next
'ahora se protege nuevamente la hoja
ActiveSheet.Protect Password:="1"
End Sub

Sdos!

Lo mismo de la anterior

Sub BorrarDesbloqueadas()
ActiveSheet.Unprotect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then
r.Interior.Color = RGB(255, 255, 255)
r.Font.Color = RGB(0, 0, 0)
r.ClearContents
End If
Next
Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
If Not Application.Intersect(img.TopLeftCell, Selection) Is Nothing Then
If img.Type = msoPicture Then img.Delete
End If
Next
'ahora se protege nuevamente la hoja
ActiveSheet.Protect Password:="1"
End Sub

Un saludo Elsa

No, no me da ningún error, solo desactiva la línea y el resto queda igual y no da error.

Sub BorrarDesbloqueadas()
ActiveSheet.Unprotect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then
'r.Interior.Color = RGB(255, 255, 255)
r.Font.Color = RGB(0, 0, 0)
r.ClearContents
End If
Next
Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
If Not Application.Intersect(img.TopLeftCell, Selection) Is Nothing Then
If img.Type = msoPicture Then img.Delete
End If
Next
'ahora se protege nuevamente la hoja
ActiveSheet.Protect Password:="1"
End Sub

Si en tu caso da error, presioná Depurar lo que te llevará al Editor marcando de color amarillo la línea errada. Toma imagen de la pantalla y subila para comprobar que realmente te marca la línea siguiente (no es que dude de tus palabras ... pero ;)

Y también recordame con qué versión estás trabajando.

Te comento que estás dando fuente blanca pero luego 'borras' el contenido de las celdas con la línea: r.Clearcontents, lo que no tiene mucho sentido.

PD) Te recuerdo que esto es una tarea 'voluntaria', no es nuestro trabajo. Por lo que un poco de paciencia si la respuesta no llega al momento.

Sdos!