Macro para asignar imagen a una celda según su nombre
Estoy trabajando con esta macro diseñada por DAM
y al trabajar con imágenes de bajo pixelaje funciona muy bien...
Pero al incluir imágenes con dimensiones 6016*4000 Resolución: 300ppp
no las coloca correctamente en la columna y fila que debe ser... No se que hay que hacer
saludos...
Sub insertarimagen()
'Por.DAM
On Error Resume Next
ruta = ActiveWorkbook.Path & "\"
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
imagen = Cells(i, "A")
Set img = ActiveSheet.Pictures.Insert(ruta & imagen)
With Cells(i, 2)
Arr = .Top
Izq = .Left
Anc = .Offset(0, 1).Left - .Left
Alt = .Offset(1, 0).Top - .Top
End With
With img
'.Name = numimg
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arr
.Left = Izq
.Width = Anc
.Height = Alt
End With
Set img = Nothing
Next
End Sub
1 Respuesta
H o l a: Prueba con la siguiente:
Sub insertarimagen()
'Por.DAM
On Error Resume Next
ruta = ActiveWorkbook.Path & "\"
For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
imagen = Cells(i, "A")
Set img = ActiveSheet.Pictures.Insert(ruta & imagen)
With Cells(i, 2)
Arr = .Top
Izq = .Left
Anc = .Width
Alt = .Height
End With
With img
'.Name = numimg
.ShapeRange.LockAspectRatio = msoFalse
.Width = Anc
.Height = Alt
.ShapeRange.SetShapesDefaultProperties
.Top = Arr
.Left = Izq
End With
Set img = Nothing
Next
End SubPrueba y me comentas.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
