Corregir macro que insertar imagen en excel
Tengo la siguiente macro y necesitaría que se ejecutara para todas las hojas visibles del libro a excepción de una en concreto.
Sub InsertarImagenes()
'Declaramos variables
Dim RutaActual As String
Dim RangoImagen As Range
Dim shp As Object
'En caso de error...
On Error Resume Next
For Each shp In ActiveSheet.Shapes
If shp.Name = "Picture 56" Then
Else
shp.Delete
End If
Next
'La variable RutaActual guardará la ruta completa donde está el archivo
RutaActual = ThisWorkbook.Path
'Desactivamos la actualización de pantalla
Application.ScreenUpdating = False
'Elegimos la celda B3
ActiveSheet.Range("B63").Select
'Recorremos cada fila mientras haya datos en la columna A
Do While ActiveCell.Offset(-61, 0).Value <> Empty
Set RangoImagen = ActiveCell.Offset(-61, 0)
'Insertamos la imagen que corresponda al nombre de la columna A
ActiveSheet.Pictures.Insert (RutaActual & "\img\" & RangoImagen.Value & ".PNG")
'Activamos la siguiente fila
ActiveCell.Offset(1, 0).Select
Loop
Range("A2").Select
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
2 respuestas
Antes de modificar esta macro, fijate si la que te dejé en respuesta anterior te sirve.
Porque la que dejas aquí, inserta más de una imagen. Se parece a la de un Catálogo, colocando una imagen por fila. No una imagen por hoja como solicitabas en consulta anterior.
De todos modos cuando se trata de recorrer la colección 'Hojas' del libro y se intenta omitir alguna (s), el código sería así:
Sub bucle_en_hojas() For Each sh In Sheets If sh.Name <> "INICIO" Then 'aquí comienza tu código para cada objeto de LA HOJA ACTIVA sh.Select For Each shp In ActiveSheet.Shapes '..... 'aquí tu código Next shp End If 'pasa a LA HOJA SIGUIENTE Next sh End Sub
Comentame si necesitas que siga ajustando tu macro.
En mi canal encontrarás otros videos con libros utilizando imágenes:
N° 49 (Catálogo con imágenes externas)
N° 50 (Libro con imágenes incorporados en el libro)
Me respondieron por otro lado!
Gracias de todos modos,
Feliz 2023 para todos!
Ramon.
Sub InsertaImagenMA(): On Error Resume Next
Application.ScreenUpdating = False
For Each hoja In Sheets
If Not hoja.Name = "Nueva plantilla" Then
hoja.Select
ActiveSheet.Shapes("CARACOLA").Delete
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\imagenes\" & [B2] & ".png").Select
Selection.Name = "CARACOLA"
With Selection.ShapeRange
.LockAspectRatio = False
.Left = Range("B1").Left + 1
.Top = Range("F63").Top + 1
.Width = 300
.Height = 230
End With
ActiveCell.Select
End If
Next
End Sub