Macro para eliminar objetos y autoformas de una rango de Excel

En la próxima versión de EXCELeINFO add-in se añadirá una nueva opción en el menú objetos que nos permitirá eliminar las autoformas y objetos que tengamos en determinado rango de una hoja de Excel.

Este menú se añade como hermano del que ya existe llamado Eliminar todos los objetos y formas de la hoja activa, liberada en la versión 2.4.5.

Cómo funciona

El primer paso será elegir el rango del cual queremos eliminar las formas. Con un contador For Next tomaremos el número de la primera fila y columna, así como de la última fila y columna del rango seleccionado.

En base a los valores de filas y columnas tomados, mediante un For each recorremos las formas y con mediante la propiedad BottomRightCell obtendremos la ubicación (fila-columna) donde cada forma está situada. Con un If else se hará la validación de si la fila y columna cada objeto se encuentra dentro del rango elegido, éstos se eliminarán.

Eliminar autoformas de un rango en Excel

Figura 1. La dirección de cada objeto se toma con la celda de la parte inferior derecha.

Código

Option Explicit
Public Const Titulo = "EXCELeINFO"
Sub EliminarObjetosRango()
'
'Declaramos variables.
Dim Celda As Range
Dim PrimeraFila As Integer
Dim PrimeraColumna As Integer
Dim UltimaFila As Integer
Dim UltimaColumna As Integer
Dim shp As Object
Dim tc As Integer
Dim tr As Integer
Dim Cuenta As Integer
Dim ErrorHandler As String
'
'En caso de error...
On Error GoTo ErrorHandler
'
'Recorre cada celda de la selección.
For Each Celda In Selection
    PrimeraFila = Celda.Row
    PrimeraColumna = Celda.Column
    GoTo Jump
Next Celda
'
Jump:
'
For Each Celda In Selection
    UltimaFila = Celda.Row
    UltimaColumna = Celda.Column
Next Celda
'
Cuenta = 0
'
'Recorre cada objeto de la hoja y valida su posición.
For Each shp In ActiveSheet.Shapes
    tc = shp.BottomRightCell.Column
    tr = shp.BottomRightCell.Row
    If (tc >= PrimeraColumna And tc <= UltimaColumna) And _
       (tr >= PrimeraFila And tr <= UltimaFila) Then
        shp.Delete
        Cuenta = Cuenta + 1
    Else
    End If
Next
MsgBox Cuenta & " objetos eliminados.", vbInformation, Titulo
'
Exit Sub
'
'En caso de detectar un error...
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, Titulo
'
End Sub

Anexos

:: Descargar el ejemplo Eliminar objetos de una rango -EXCELeINFO.rar

You may also like...

10 Responses

  1. Kirill Lapin says:

    Hola Sergio, has considerado el uso de Intesect() para simplificar el código? Por ejemplo: If Not Intersect(Selection,shp.BottomRightCell) Is Nothing Then shp.Delete

    • sergioacamposh says:

      Gracias por la anotación KL. Tienes razón en que el código se puede simplificar. Ha quedado así.

      Sub EliminarObjetosRango2()

      ‘Declaramos variables.
      Dim shp As Object
      Dim Cuenta As Integer
      Dim ErrorHandler As String

      ‘En caso de error…
      On Error GoTo ErrorHandler

      Cuenta = 0

      ‘Recorre cada objeto de la hoja y valida su posición.
      For Each shp In ActiveSheet.Shapes
      If Not Intersect(Selection, shp.BottomRightCell) Is Nothing Then
      shp.Delete
      Cuenta = Cuenta + 1
      Else
      End If
      Next
      MsgBox Cuenta & ” objetos eliminados.”, vbInformation, Titulo

      Exit Sub

      ‘En caso de detectar un error…
      ErrorHandler:
      MsgBox “Ha ocurrido un error: ” & Err.Description, vbExclamation, Titulo

      End Sub

  2. Angel De Garibay Flores says:

    men me podras ayudar ocn un formulario que tengo una dudas que no encuentro como hacerle queiro que un txtbox valide la informacion ingresada con la informacion guardada que tengo en hoja2 ejemplo si noes correcto el dato no deje seguir el siguente paso no se si me entendistes
    angelfloresrivera@hotmail.com
    si m epuedes ayduar te lo agradeceria mucho

    • sergioacamposh says:

      Puedes usar algo así:

      If me.Textbox1.Value Sheets(“Hoja2”).Range(“A1”) then
      msgobx “No puedes continuar”
      Else
      ‘Continúa

  3. javier says:

    soy nuevo en esto tengo 2 tablas y deseo llenar un formulario con datos de estas tablas tengo la tabla A con los campos id,nombre y la tabla B con los campos id,nombre,semestre,grupo tengo un formulario con un listbox y me carga los datos de la tabla A y lleno los campos del formulario y al guardar los datos en la tabla B se me guardan todos correctamente en la tabla,pero a la hora de abrir el formulario cargo el listbox me carga los datos de la tabla A en vez de los de la tabla B deseo que me cargue los datos de la tabla B previamente llenados,me podrian ayudar por favor

    • sergioacamposh says:

      Cuál es el código que usas para llenar el Lixtbox ?

      • javier says:

        ***aki cargo los datos de la tabla B
        Private Sub c_Nombre_Change()
        On Error Resume Next

        Application.ScreenUpdating = True
        If nCli(c_nombre.Text) 0 Then

        Sheets(“prestamos”).Activate
        Cells(c_nombre.ListIndex + 2, 1).Select
        nombre = ActiveCell.Offset(0, 1)
        grupo = ActiveCell.Offset(0, 2)
        sem = ActiveCell.Offset(0, 3)
        areacon = ActiveCell.Offset(0, 4)
        edit = ActiveCell.Offset(0, 5)
        edic = ActiveCell.Offset(0, 6)
        numclas = ActiveCell.Offset(0, 7)
        fech = ActiveCell.Offset(0, 8)
        tipres = ActiveCell.Offset(0, 10) ‘ tipo de prestamo
        status = ActiveCell.Offset(0, 11)

        Else

        nombre = “”
        grupo = “”
        sem = “”
        areacon = “”
        edit = “”
        edic = “”
        numclas = “”
        fech = “”
        tipres = “”
        status = “”

        End If

        End Sub
        *****Aki cargo los datos de la tabla A y muestra los campos que quiero para la tabla B
        Private Sub c_Nombre_Enter()
        CargarLista
        End Sub
        Sub CargarLista()
        c_nombre.Clear
        Sheets(“Alta de libros”).Select
        Range(“A2”).Select
        Do While Not IsEmpty(ActiveCell)
        c_nombre.AddItem ActiveCell.Value
        ActiveCell.Offset(1, 0).Select
        Loop
        End Sub

        ***Lo que deseo hacer es que me cargue los datos de la tabla B cuando llene el formulario y guarde no los de la A por que al iniciar el formulario me muestra los datos de la tabla A en vez de los de la tabla B No se si me llego a explicar??
        Solo quiero que Al iniciar La primera vez el form me cargue los datos de la tabla A y al momento de llenar los campos y guardar, y al volver a Cargar el formulario Me muestre los datos que estan en la tabla B previamente llenados

  4. javier says:

    tengo una tabla llamada prestamos en la cual tengo una tabla y obtengo con un combobox los valores del libro como nombre,autor,editorial num de clasificación este ultimo es lo que identifica al libro como único pero
    existen muchos libros con el mismo nombre el
    problema es que si quiero cargar otro libro que se llame igual aunque su
    num de clasificación sea diferente solo me muestra el primero que
    cargue y no el o los siguientes siguiente necesito ayuda por favor ejemplo tengo 2 libros de física su num de clasificación es CB-MF-001 y del otro libro es CB-MF-002

    al iniciar el combobox me carga el primero hago una operación de préstamo del primer libro y deseo prestar el segundo libro pero al momento de cargar el nombre del libro no me carga su num de clasificación sino que me carga el num de clasificación del primero

    • sergioacamposh says:

      Cuando buscas el nombre del libro lo haces con BUSCARV ??

      Si es así, te recomiendo que hagas una lista donde concatenes el Nombre y la Clasificacación para que sean nombre únicos.

  5. Francisco Leon III says:

    Hola, espero me puedan ayudar, tengo un problema con mi macro, lo que hace es mandar imprimir una lista de tarjetas de produccion y en cada una de ellas se debe de imprimir la foto asociada al estilo (es de calzado). Si lo ejecuto con f8 puedo ver como se van cambiando las imagenes sin problema pero al mandar imprimir me deja solo la primera imagen y todas las demas tarjetas salen con la misma foto. Tendran alguna solucion.

    Este es el codigo que estoy usando (disculpen la simpleza pero soy nuevo en programacion en Excel).

    Sub ImpTarjeta()

    Range(“aa2″).Select

    Dim cont As Integer

    cont = 1

    Do While ActiveCell.Value “”

    ‘Aqui creo la cadena para el nombre del archivo

    Range(“q2″).Value = ActiveCell.Value

    Set fso = CreateObject(“Scripting.FileSystemObject”)

    nombre = Range(“aa21″).Value

    ‘ Aqui valido si el archivo existe para que lo ponga en el control de imagen

    If (fso.FileExists(“D:DocumentosGoogle DriveOneDriveTaller ProduccionEstilosImagenes Tarjetas” & nombre & “.jpg”)) Then

    ActiveSheet.FotoTarjeta.Picture = LoadPicture(“D:DocumentosGoogle DriveOneDriveTaller ProduccionEstilosImagenes Tarjetas” & nombre & “.jpg”)

    End If

    ‘Selecciono el rango que quiero imprimir y mando la impresion

    Range(“A1:T29″).Select

    Selection.PrintOut Copies:=1, Collate:=True

    cont = cont + 1

    ActiveCell.Offset(0, 9).Select

    ActiveCell.Offset(cont, 0).Select

    Loop

    End Sub

Leave a Reply

Your email address will not be published.

%d bloggers like this: