Excel - Necesito ayuda con error 1004 en excel al copiar una imagen.

 
Vista:
sin imagen de perfil

Necesito ayuda con error 1004 en excel al copiar una imagen.

Publicado por Edgar (1 intervención) el 08/06/2019 00:01:00
Buenas tardes compañeros, estoy comenzando en la programación de macros y necesito copiar unas imágenes que se encuentran en otro libro, la manera en la que estoy copiando la imagen la utilizó anteriormente en otros módulos sin problema, pero al llegar a la ejecución de esta función me aparece el error 1004. Error definido por la aplicación o el objeto.

El libro donde se encuentra la macro lo tengo referenciado como "macro", mientras que el reporte donde copio la imagen se llama "reporte", lo que hago es un barrido de todas las imágenes de la hoja "TORRE SITIO A" del reporte, posteriormente me encargo de copiar aquellas que se encuentran en una determinada región de la hoja. Como mencione utilizando el método en otras funciones de la macro funciona correctamente, pero al llegar a está marca un error.

Espero puedan ayudarme un poco sobre el motivo del error y la manera de solucionarlo.

Saludos y gracias!


Function torrea(macro As Workbook, reporte As Workbook) As Boolean
Dim hojatorrea As Worksheet
Dim buscar As Range
Dim fila As Long
Dim filafinal As Long
Dim RutaActual As String
Dim celda As Range
Dim shp As Shape
Dim imagenes As Shape
RutaActual = macro.Path
macro.Worksheets("TORRE SITIO A").Activate
Set hojatorrea = ActiveSheet
With hojatorrea
.Range("B6:I6").Merge
.Range("B6:I6").Value = "Diagrama de Torre A"
Call FormatoTexto(macro, 10, "TORRE SITIO A", "B6:I6")
.Range("A8:J8").Merge
.Range("A8:J8").Value = macro.Worksheets("UBICACIÓN DE SITIOS").Range("D9:F9").Value
Call FormatoTexto(macro, 10, "TORRE SITIO A", "A8:J8")
.Range("A8:J8").Interior.color = RGB(228, 226, 236)

'Procede a copiar la información
Set buscar = reporte.Worksheets("TORRE SITIO A").Columns("E:I").Find(What:="ALTURA TOTAL", LookIn:=xlValues)
If Not buscar Is Nothing Then
fila = buscar.Row
Set buscar = reporte.Worksheets("TORRE SITIO A").Columns("E:J").Find(What:="DETALLE DE TORRE", LookIn:=xlValues)
If Not buscar Is Nothing Then
'Se procede a copiar los valores
For Each celda In reporte.Worksheets("TORRE SITIO A").Range("A" & fila & ":J" & buscar.Row)
celda.Copy
.Range(obtenerrange(celda.Address)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
macro.Application.CutCopyMode = False
Next celda
Else
MsgBox "No se encuentra la DETALLE DE TORRE de la torre en el reporte.", vbOKOnly + vbCritical, "Error"
torrea = True
GoTo Error
End If
Else
MsgBox "No se encuentra la ALTURA TOTAL de la torre en el reporte.", vbOKOnly + vbCritical, "Error"
torrea = True
GoTo Error
End If
.Columns("D").ColumnWidth = 17.86

'HASTA AQUÍ EL CÓDIGO FUNCIONA CORRECTAMENTE-------------------------------------------------------------------------

'Se copia la imagen de la torre
For Each shp In reporte.Worksheets("TORRE SITIO A").Shapes
If (shp.Top > .Range("A7").Top) And (shp.Top < .Range("A" & buscar.Row).Top) And (shp.Left < .Range("K1").Left) Then
Set imagenes = shp
nombrereal = imagenes.Name
imagenes.Name = "FixedName"
imagenes.Copy '<-----------------------------------------------EN ESTA LÍNEA APARECE EL ERROR
.Paste
macro.Application.CutCopyMode = False
.Shapes("FixedName").Top = .Range("A13").Top
.Shapes("FixedName").Left = imagenes.Left + 25
imagenes.Name = nombrereal
.Shapes("FixedName").Name = nombrereal
End If
Next shp
End With

'Pega la imagen inferior
Call pegarimagen(macro, "TORRE SITIO A", "inferior" _
, hojatorrea.Range("A52").Top + 14 _
, Application.CentimetersToPoints(0.1) _
, Application.CentimetersToPoints(3.7) _
, Application.CentimetersToPoints(22.36)) 'TOP,LEFT,HEIGHT,WIDTH

Error:
End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder