insertar imágenes en excel desde vba Escucha este post

Toda esta semana me la pase trasnochandome con café y progrmando unas lineas que mi amiga me pidio(gracias ñoña).Bueno también fue interesante de las tantas cosas que encontré fue como subir imágenes desde vba.

la función es :

ActiveSheet.Pictures.Insert()

que inserta una imagen , como argumento usa un String para la imagen pero la verdad que seria muy incomodo tener que escribir una direccion en una celda para que tomara como argumento

asi que tube que encontrar una forma de sacar un explorador de archivos desde vba, pense que tendria que hacerlo desde los forms de vb pero por suerte di con esta otra joyita:

FileDialog

Veamos cono funcionan esta función y este objeto

'modulo para las fotos

Function SelecionarArchivos()

'declaramos fd como FileDialog y lo hacemos del tipo selector de archivos

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

'escojer un unico archivo de tipo imagen

.AllowMultiSelect = False

.Filters.Add "Imagenes", "*.bmp;*.jpg;*.gif;*.ico;*.wmf", 1

.FilterIndex = 1

' ejecutar el cuadro si ceduelve verdadero llamar a cargar imagen

If .Show = -1 Then

SelecionarArchivos = .SelectedItems(1)

' si escojemos AllowMultiSelect = true para escojer multiples archivos

' y queremos dar con cada archivo podemos usarun each para cada valor de la collecion

Else

MsgBox "No se ha seleccionado ningún archivo", vbExclamation

End If

End With

Set fd = Nothing 'limpiar memoria

End Function

Sub subirImagenALibro(imagenAImportar As String)

'importar una imagen

ActiveSheet.Pictures.Insert(imagenAImportar).Select

'redimencionar imagenes para que no sean muy grandes

' guardamos la relación de ratio

ratio = Selection.ShapeRange.Height / Selection.ShapeRange.Width

' con la imagen seleccionada aun cambiamos sus dimensiones

Selection.ShapeRange.Height = 220

Selection.ShapeRange.Width = 220 / ratio

'posicionar en la celd activa encontrar esto también fue algo interesante

Selection.ShapeRange.Top = ActiveCell.Top

Selection.ShapeRange.Left =ActiveCell.Left

End Sub

ahora solo tenemos que escribir

Public Sub agregarImagen()

Arch = SelecionarArchivos

subirImagenALibro (Arch)

End Sub

donde seleccionamos un archivo y le pasamos el string con la direccion a subirImagenALibro()

Espero que les emocione las posibilidades como a mi

Ahora la cuestión es que si se suben muchos archivos el archivo excel va a pesar mucho por lo cual no es muy conveniente por lo que creare un archivo aparte que sera el que se mande...

esperen la próxima entrada para ver como lo hago.

Les dejo un link de lo actual en mi pagina y en mi live

Espero que les emocione las posibilidades como a mi