Access - foto a excel

Option Compare Database

Option Explicit

Sub ExportarFotografia()

    Dim excelApp As Excel.Application

    Dim excelWorkbook As Excel.Workbook

    Dim excelWorksheet As Excel.Worksheet

    Dim fotoPath As String

    Dim fotoCell As Excel.Range

    ' Ruta de la imagen que deseas exportar

    fotoPath = "C:\Ruta\De\La\Imagen\foto.jpg"

    ' Abre una instancia de Excel

    Set excelApp = New Excel.Application

    excelApp.Visible = True

    ' Crea un nuevo libro en Excel

    Set excelWorkbook = excelApp.Workbooks.Add

    ' Especifica la hoja en la que deseas colocar la imagen

    Set excelWorksheet = excelWorkbook.Sheets("Hoja1")

    ' Encuentra la celda donde deseas colocar la imagen

    Set fotoCell = excelWorksheet.Range("A1")

    ' Inserta la imagen en la celda especificada

    excelWorksheet.Pictures.Insert(fotoPath).Select

    excelApp.Selection.ShapeRange.LockAspectRatio = msoFalse

    excelApp.Selection.ShapeRange.Width = fotoCell.Width

    excelApp.Selection.ShapeRange.Height = fotoCell.Height

    excelApp.Selection.ShapeRange.Top = fotoCell.Top

    excelApp.Selection.ShapeRange.Left = fotoCell.Left

    ' Cierra la conexión con Excel

    Set fotoCell = Nothing

    Set excelWorksheet = Nothing

    excelWorkbook.Close SaveChanges:=True

    Set excelWorkbook = Nothing

    excelApp.Quit

    Set excelApp = Nothing

    MsgBox "La fotografía se ha exportado correctamente a Excel.", vbInformation

End Sub