Macro para cargar una imagen en una celda
Hola de nuevo, mi pregunta es por una macro para cargar una imagen por ejemplo en la celda C5, ya tengo esta macro que me envío el experto Dante:
Sub InsertarImagen()
'Por.Dante Amor
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de imagen"
.Filters.Clear
.Filters.Add "Todos los archivos", "*.*"
.Filters.Add "*.jpg", "*.jp*"
.Filters.Add "*.bmp", "*.bmp"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
If .Show Then
archivo = .SelectedItems.Item(1)
ActiveSheet.Pictures.Insert(archivo).Select
End If
End With
End Sub
nuevamente gracias por tu tiempo
1 Respuesta
Te anexo la macro actualizada, cambia en la macro la celda C5 por la celda que desees.
Sub InsertarImagen() 'Por.Dante Amor celda = "C5" ' With Application.FileDialog(msoFileDialogFilePicker) .Title = "Seleccione archivo de imagen" .Filters.Clear .Filters.Add "Todos los archivos", "*.*" .Filters.Add "*.jpg", "*.jp*" .Filters.Add "*.bmp", "*.bmp" .FilterIndex = 2 .AllowMultiSelect = False .InitialFileName = ThisWorkbook.Path If .Show Then archivo = .SelectedItems.Item(1) ActiveSheet.Pictures.Insert(archivo).Select ' arr = Range(celda).Top izq = Range(celda).Left hei = Range(celda).Height wid = Range(celda).Width With Selection .Placement = xlMoveAndSize .PrintObject = True .ShapeRange.LockAspectRatio = msoFalse .ShapeRange.Top = arr .ShapeRange.Left = izq .ShapeRange.Height = hei .ShapeRange.Width = wid .ShapeRange.Name = archivo End With End If End With End Sub
Saludos.Dante Amor
