Me gustaría simplificar esta macro
Esta es la macro:
Sub BorrarMiaSeleccion()
Call BorrarDesbloqueadas
Call Borrar1
Call finalizar_las_macros_así
End Sub
Y esto depende de :
Sub BorrarDesbloqueadas()
ActiveSheet.Protect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then r.ClearContents
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
Sub Borrar1()
Call comenzar_las_macros_así
Dim r As Range
'se recorre el rango seleccionado previamente
For Each r In Selection
'si alguna celda está desbloqueada, se cambia color de fondo y fuente blanca
If r.Locked = False Then
'r.Font.Color = NEGRO
r.Font.Color = RGB(0, 0, 0)
'se limpia contenido
r.ClearContents
r.Interior.Color = RGB(255, 255, 255)
End If
Next
End Sub
Sub comenzar_las_macros_así()
ActiveSheet.Unprotect Password:="1"
Application.ScreenUpdating = False ' Apagar el parpadeo de pantalla
Application.Calculation = xlCalculationManual ' Apagar los cálculos automáticos
Application.EnableEvents = False ' Apagar los eventos automáticos
End Sub
Sub finalizar_las_macros_así()
Application.ScreenUpdating = True ' Debemos volver a su estado original El parpadeo de pantalla
Application.Calculation = xlCalculationAutomatic ' Debemos volver a su estado original Los cálculos automáticos
Application.EnableEvents = True ' Debemos volver a su estado original Los eventos automáticos
Application.CutCopyMode = False ' Borrar contenido de portapapeles
Application.ErrorCheckingOptions.BackgroundChecking = True ' Habilitar comprobacion de errores
ActiveSheet.Protect Password:="1"
End Sub
1 respuesta
Entre las 2 primeras de Borrar se repiten instrucciones, por lo que dejé 1 sola.
Y lo de llamar a las 2 de acciones comunes, bien podrías colocar esas instrucciones dentro de la macro, pero mantenelas separadas si las necesitarás en otros procesos.
No tengo ni idea de cómo están ubicadas tus imágenes, quizás debas subir una imagen de tu hoja o enviármela a mi correo, como para ajustar las instrucciones del 2do bucle que ahora está dentro del 1ro.
Con este cambio no necesitas la de las llamadas, solo se llama a Borrar1.
Sub Borrar1() 'ajustada x Elsamatilde 'se desproteje la hoja y otras acciones comunes Call comenzar_las_macros_así Dim r As Range 'se recorre el rango seleccionado previamente For Each r In Selection 'si alguna celda está desbloqueada, se cambia color de fondo y fuente blanca If r.Locked = False Then 'color de fuente r.Font.Color = RGB(0, 0, 0) 'se limpia contenido r.ClearContents 'color de trama r.Interior.Color = RGB(255, 255, 255) 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 'se protege la hoja y otras acciones comunes Call finalizar_las_macros_así End Sub Sub comenzar_las_macros_así() ActiveSheet.Unprotect Password:="1" Application.ScreenUpdating = False ' Apagar el parpadeo de pantalla Application.Calculation = xlCalculationManual ' Apagar los cálculos automáticos Application.EnableEvents = False ' Apagar los eventos automáticos End Sub Sub finalizar_las_macros_así() Application.ScreenUpdating = True ' Debemos volver a su estado original El parpadeo de pantalla Application.Calculation = xlCalculationAutomatic ' Debemos volver a su estado original Los cálculos automáticos Application.EnableEvents = True ' Debemos volver a su estado original Los eventos automáticos Application.CutCopyMode = False ' Borrar contenido de portapapeles Application.ErrorCheckingOptions.BackgroundChecking = True ' Habilitar comprobacion de errores ActiveSheet.Protect Password:="1" End Sub
