Macro ajustar tamaño de imagen desde carpeta externa
Para Dante Amor:
Estimado, tengo esta excelente macro que rescata imagenes en jpg y jepg desde una carpeta externa.
La macro funciona perfecto, pero me gustaría saber como lo hago para poder ajustar el tamaño de la imagen y/o dejarla fija en la celda (fila A), ya que al ordenar de < a > la fila B, las fotos no se ordenan y la idea es que la fotos también se ordenen o muevan junto a la fila B.
Muchas gracias por tu ayuda.
Sub im4()
'Por.Dante Amor
ruta = "C:\Users\jromero\Desktop\Análisis\NVAS MARCAS\Zapatillas\FOTOS (Varias Marcas)\"
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
arch = Dir(ruta & Cells(i, "B") & ".jp*")
If arch <> "" Then
With Cells(i, "A")
Arriba = .Top
Izquierda = .Left
Ancho = .Width
Alto = .Height
End With
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
End If
Next
End Sub
1 respuesta
H o l a:
Ya hice pruebas con esta macro y puedo seleccionas las celdas y ordenarlas y las imágenes se mueven con su respectivo nombre.
Sub im4()
'Por.Dante Amor
ruta = "C:\trabajo\varios\"
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
arch = Dir(ruta & Cells(i, "B") & ".jp*")
If arch <> "" Then
With Cells(i, "A")
Arriba = .Top + 1
Izquierda = .Left + 1
Ancho = .Width - 2
Alto = .Height - 2
End With
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
End If
Next
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
