¿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.

Respuesta
1

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.

1 respuesta más de otro experto

Respuesta

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!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas