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.
Espero que les emocione las posibilidades como a mi
