¿Como inserter una imagen mediante un botón vba?
Inicié un sistema de registro, el cual tiene como objetivo el registro de incidencias diarias dentro de un area determinada.
Los campos a registrar son:
- Folio
- fecha
- Tipo de incidencia
- Hora del reporte
- Personal involucrado
- Detalles del evento
- Imágenes del evento.
Los 6 primeros puntos ya los tengo cubiertos mediante un formulario de registro enlazados a Excel mediante vba y mi pregunta es la siguiente:
¿De que manera sería posible agregar un botón a dicho formulario que fungiera como enlace de selección para carga de imagines (Tipo botón Examinar), el cual me permita seleccionar desde X lugar una imagen.
2 Respuestas
Puedes poner algo así:
Private Sub CommandButton1_Click() Dim abririmagen As Office.FileDialog Set abririmagen = Application.FileDialog(msoFileDialogFilePicker) With abririmagen .AllowMultiSelect = False .Title = "Selecciona imagen" . Filters. Clear . Filters.Add "JPG", "*.JPG" . Filters. Add "JPEG File Interchange Format", "*.JPEG" . Filters. Add "Graphics Interchange Format", "*.GIF" . Filters.Add "Portable Network Graphics", "*.PNG" . Filters.Add "Tag Image File Format", "*.TIFF" .Filters.Add "All Pictures", "*.*" If .Show = -1 Then ActiveSheet.Pictures.Insert (.SelectedItems(1)) End If End With End Sub
Al dar click en el botón te abre una ventana para insertar y luego la inserta directamente a la hoja activa.
Suerte
Daniel Espino Muchas gracias por el aporte, de entrada cumple la función que requiero (Insertar una imagen en X celda de la hoja), lo cual ES EXCELENTE!
¿Habría manera de definir que fuese siempre en la K2, dado que será insertado un renglón cada vez que se haga un registro nuevo desde el formulario.
Desde ya muchisimas gracias por el apoyo a mi humilde proyecto. Saludos!
Solo tendrías que seleccionar la celda, usa esta:
Private Sub CommandButton1_Click() Dim abririmagen As Office.FileDialog Set abririmagen = Application.FileDialog(msoFileDialogFilePicker) ActiveSheet.Cells(2, 11).Activate With abririmagen .AllowMultiSelect = False .Title = "Selecciona imagen" . Filters. Clear . Filters.Add "JPG", "*.JPG" . Filters. Add "JPEG File Interchange Format", "*.JPEG" . Filters. Add "Graphics Interchange Format", "*.GIF" . Filters.Add "Portable Network Graphics", "*.PNG" . Filters.Add "Tag Image File Format", "*.TIFF" .Filters.Add "All Pictures", "*.*" If .Show = -1 Then ActiveSheet.Pictures.Insert (.SelectedItems(1)) End If End With End Sub
Daniel Espino Una disculpa por no haberme reportado antes debido a auditorias en mi trabajo. Te agradezco infinitamente el apoyo ya quedó perfecto.
Daniel Espino Buenas tardes:
¿Habrá manera de que la imagen insertada desde el formulario tuviera una dimension especifica de 2.30cm por 2.30cm?
De antemano agradezco la gran ayuda que me haz dado.
Daniel Espino Las imágenes se insertan en el documento de excel perfectamente. sin embargo he creado un archivo en Word con el cual combina correspondencia de la BDD creada en excel. La cual se muestra de la siguiente manera:
Aqui no se visualizan =(
El código vba uilizado para cargar la imagen funciona excelente, el cual es el siguiente:
---------------------------------------------------
Private Sub Image1_Click()
Dim abririmagen As Office.FileDialog
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
ActiveSheet.Cells(2, 10).Activate
With abririmagen
.AllowMultiSelect = False
.Title = "Selecciona imagen"
.Filters.Clear
.Filters.Add "JPG", "*.JPG"
.Filters.Add "JPEG File Interchange Format", "*.JPEG"
.Filters.Add "Graphics Interchange Format", "*.GIF"
.Filters.Add "Portable Network Graphics", "*.PNG"
.Filters.Add "Tag Image File Format", "*.TIFF"
.Filters.Add "All Pictures", "*.*"
If .Show = -1 Then
ActiveSheet.Pictures.Insert (.SelectedItems(1))
End If
End With
----------------------------------------
Nota: Las imagines insertadas en las celdas no se visualizan en el documento de word, a continuación les maestro el ejemplo:
De antemano agradezco el apoyo a este humilde proyecto. Saludos!
No pasa nada no siempre tenemos tiempo, yo también he estado muy ocupado.
Para el tamaño solo necesitas agregar estas 2 lineas y unos cuantos arreglos.
Quedaría algo así
Private Sub CommandButton1_Click() Dim abririmagen As Office.FileDialog Dim img As Object Set abririmagen = Application.FileDialog(msoFileDialogFilePicker) ActiveSheet.Cells(2, 11).Activate With abririmagen .AllowMultiSelect = False .Title = "Selecciona imagen" . Filters. Clear . Filters.Add "JPG", "*.JPG" . Filters. Add "JPEG File Interchange Format", "*.JPEG" . Filters. Add "Graphics Interchange Format", "*.GIF" . Filters.Add "Portable Network Graphics", "*.PNG" . Filters.Add "Tag Image File Format", "*.TIFF" .Filters.Add "All Pictures", "*.*" If .Show = -1 Then Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1)) img.Width = 300 img.Height = 300 End If End With End Sub
Solo le cambias las medidas por las que necesites.
Respecto a lo de word no se como lo pases pero al copiar a word solo te copia las celdas mas no los objetos (de hecho ni se seleccionan) y creo que no es posible seleccionar imágenes y objetos al mismo tiempo.
Por ultimo respecto al formulario, jamás lo mencionaste, y también requieren de instrucciones para que carguen.
Puedes usarlo con la instrucción:
Image1.Picture = LoadPicture (la ruta de tu imagen)
Daniel Espino Buenas tardes:
De Nuevo agradeciendo tu gran ayuda en este humilde proecto. Ha quedado resuelto el tema de las medidas, va perfecto con la modificación.
Sobre el tema del enlace de Excel a Word, se lleva a cabo mediante la combinación de correspondencia. Esto permite que los datos ingresados en cada uno de los registros de nuestra BDD, se ingresen en el document de Word en los campos correspondientes.
Quedo en espera de tus comentarios.
Igual si me proporcionas tu correo, puedo mandarte ambos archivos para que veas como funcionan y ver la posibilidad de lograr la transferencia de imagines dentro de la BDD.
Muchas gracias. =D
Intenta otra vez con este arreglo:
Private Sub CommandButton1_Click() Dim abririmagen As Office.FileDialog Dim img As Object Set abririmagen = Application.FileDialog(msoFileDialogFilePicker) ActiveSheet.Cells(2, 11).Activate With abririmagen .AllowMultiSelect = False .Title = "Selecciona imagen" . Filters. Clear . Filters.Add "JPG", "*.JPG" . Filters. Add "JPEG File Interchange Format", "*.JPEG" . Filters. Add "Graphics Interchange Format", "*.GIF" . Filters.Add "Portable Network Graphics", "*.PNG" . Filters.Add "Tag Image File Format", "*.TIFF" .Filters.Add "All Pictures", "*.*" If .Show = -1 Then Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1)) img.Width = 50 img.Height = 50 img.Placement = xlMoveAndSize img.PrintObject = True End If End With End Sub
Cabe recalcar que la celda K2 debe tener exactamente el mismo tamaño que la imagen a insertar.
Con esto (creo) ya debería de poder pasar.
En caso contrario mi correo es [email protected]
Lo revisamos.
Desgraciadamente tengo un problema con mis licencias de office y no me fue posible revisar tus documentos, sin embargo, te propongo la siguiente solución:
Hay que hacer algunos cambios
El botón con el que llamas el cuadro quedaría así:
Private Sub CommandButton1_Click() MiRuta = SelFile1() Me.TextBox1.Value = MiRuta ActiveSheet.Cells(2, 11).Value = TextBox1.Value End Sub
Con esto obtenemos la ruta de la imagen la cual necesitarás para la combinación de correspondencia quedará debajo de la imagen así que no se verá, la ruta del archivo no logre almacenarla como variable así que necesitarás un textbox extra para almacenar ahí la ruta.
Lo siguiente es hacer todo el demás código como función publica:
Public Function SelFile1() As String Dim fd As FileDialog, Result As Integer Dim img As Object Set fd = Application.FileDialog(msoFileDialogFilePicker) ActiveSheet.Cells(2, 11).Activate With fd .AllowMultiSelect = False .Title = "Selecciona imagen" . Filters. Clear . Filters.Add "JPG", "*.JPG" . Filters. Add "JPEG File Interchange Format", "*.JPEG" . Filters. Add "Graphics Interchange Format", "*.GIF" . Filters.Add "Portable Network Graphics", "*.PNG" . Filters.Add "Tag Image File Format", "*.TIFF" .Filters.Add "All Pictures", "*.*" If .Show = -1 Then SelFile1 = .SelectedItems(1) Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1)) img.Width = 50 img.Height = 50 img.Placement = xlMoveAndSize img.PrintObject = True Else MsgBox "No se ha seleccionado" End If End With End Function
Esto hará lo mismo que se ha estado trabajando.
Ahora, con word creo que no es posible pasar las imágenes directamente con la combinación por eso necesitábamos la ruta.
Cuando hagas la combinación de correspondencia necesitaras insertar un campo llamado includepicture y le das la columna donde puso las rutas, para visualizarla necesitas presionar Alt + F9 para que carguen las imágenes, esto deberás hacerlo cada que cambies los campos, también se puede hacer con macros pero no conozco muy bien las funciones de word como para poderte ayudar en eso.
Y con esto quedaría resulto ese problema.
Private Sub CommandButton1_Click()
Dim fname As String
fname = Application.GetOpenFilename(filefilter:= _
"Bitmap Files(*.jpg),*.jpg", Title:="Select Image To Open") 'SOLO ABRE IMAGENES JPG, PERO PUEDES AÑADIR MAS FORMATOS
If fname <> "False" The
Image1.Picture = LoadPicture(fname)
Me.Repaint
End If
End Sub
Pulsando sobre el botón se abre un cuadro de dialogo donde se selecciona una imagen y se coloca dentro del recuadro Image1.
Necesitas un botón y un cuadro imagen
¡Gracias! Carlos Arrocha por tomar de tut tiempo para ayudarme, sin embargo la respuesta de Daniel Espino se adapta perfecto a lo que requiero para este proyecto.
Saludos!