SOLVED

extract image from Ms Excel using Ms Access Vba

%3CLINGO-SUB%20id%3D%22lingo-sub-2306732%22%20slang%3D%22en-US%22%3Eextract%20image%20from%20Ms%20Excel%20using%20Ms%20Access%20Vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2306732%22%20slang%3D%22en-US%22%3E%3CP%3EUsing%20MS%20Access%20and%20Vba%2C%20I%20need%20to%20extract%20images%20contained%20in%20an%20excel%20file%2C%20sheet%20n.%202%20and%20save%20them%20in%20a%20directory%20on%20the%20pc.%3CBR%20%2F%3EWhere%20can%20I%20find%20information%3F%3CBR%20%2F%3EThanks%20in%20advance%3C%2FP%3E%3CP%3EMarco%20Dell'Oca%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2306732%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EAccess%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2434606%22%20slang%3D%22en-US%22%3ERe%3A%20extract%20image%20from%20Ms%20Excel%20using%20Ms%20Access%20Vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2434606%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1040736%22%20target%3D%22_blank%22%3E%40Marco_DellOca%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20use%20this%20in%20Excel%20(VBA).%20This%20subroutine%20exports%20pictures%20by%20first%20converting%20them%20to%20a%20chart%20object%20that%20can%20be%20saved%20to%20a%20folder.%20You%20can%20either%20use%20this%20in%20Excel%20or%20port%20it%20to%20Access%20VBA%3A%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3ESub%20SaveAllPictures()%0A%20%20%20%20Dim%20shPictures%0A%20%20%20%20Set%20shPictures%20%3D%20ActiveWorkbook.Sheets(2)%0A%20%20%20%20%0A%20%20%20%20Dim%20oShape%20As%20Shape%0A%20%20%20%20Dim%20strPictureName%20As%20String%0A%20%20%20%20Dim%20oChartObject%20As%20ChartObject%0A%20%20%20%20Dim%20oChart%20As%20Chart%0A%20%20%20%20%0A%20%20%20%20For%20Each%20oShape%20In%20ActiveSheet.Shapes%0A%20%20%20%20%20%20%20%20strPictureName%20%3D%20oShape.Name%0A%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20oShape.Select%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.Contrast%20%3D%200.5%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.Brightness%20%3D%200.5%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.ColorType%20%3D%20msoPictureAutomatic%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.TransparentBackground%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.Fill.Visible%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.Line.Visible%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.Rotation%20%3D%200%23%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.CropLeft%20%3D%200%23%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.CropRight%20%3D%200%23%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.CropTop%20%3D%200%23%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.PictureFormat.CropBottom%20%3D%200%23%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.ScaleHeight%201%23%2C%20msoTrue%2C%20msoScaleFromTopLeft%0A%20%20%20%20%20%20%20%20Selection.ShapeRange.ScaleWidth%201%23%2C%20msoTrue%2C%20msoScaleFromTopLeft%0A%0A%20%20%20%20%20%20%20%20Application.Selection.CopyPicture%0A%20%20%20%20%20%20%20%20Set%20oChartObject%20%3D%20ActiveSheet.ChartObjects.Add(0%2C%200%2C%20oShape.Width%2C%20oShape.Height)%0A%20%20%20%20%20%20%20%20Set%20oChart%20%3D%20oChartObject.Chart%0A%20%20%20%20%20%20%20%20oChartObject.Activate%0A%20%20%20%20%20%20%20%20With%20oChart%0A%20%20%20%20%20%20%20%20%20%20%20%20.ChartArea.Select%0A%20%20%20%20%20%20%20%20%20%20%20%20.Paste%0A%20%20%20%20%20%20%20%20%20%20%20%20.Export%20(%22...%22%20%26amp%3B%20strPictureName%20%26amp%3B%20%22.jpg%22)%20'%26lt%3B--%20add%20your%20folder%20here%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20oChartObject.Delete%0A%20%20%20%20Next%0A%20%20%20%20%0A%20%20%20%20Set%20shPictures%20%3D%20Nothing%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EBest%20regards%2C%3C%2FP%3E%3CP%3ETieme%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2435794%22%20slang%3D%22en-US%22%3ERe%3A%20extract%20image%20from%20Ms%20Excel%20using%20Ms%20Access%20Vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2435794%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F131546%22%20target%3D%22_blank%22%3E%40Tieme%20Woldman%3C%2FA%3E%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22VIiyi%22%3E%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3Ethanks%20Tieme%2C%3C%2FSPAN%3E%3C%2FSPAN%3E%20%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22VIiyi%22%3E%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3EI%20solved%20the%20problem%20by%20reading%20the%20Excel%20file%20from%20Access%20in%20this%20way%3A%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3E%20%20%20%20Dim%20XL%20As%20Excel.Application%0A%20%20%20%20Dim%20WB%20As%20Excel.Workbook%0A%20%20%20%20Dim%20WS%20As%20Excel.Worksheet%0A%20%20%20%20Dim%20SH%20As%20Excel.Worksheet%0A%20%20%20%20%0A%20%20%20%20Set%20XL%20%3D%20CreateObject(%22Excel.Application%22)%0A%20%20%20%20Set%20WB%20%3D%20XL.Workbooks.Open(%3CFILE%20excel%3D%22%22%20path%3D%22%22%3E)%0A%20%20%20%20XL.Visible%20%3D%20False%0A%20%20%20%20WB.Worksheets(sheet_no%20%2B%201).Select%0A%20%20%20%20Set%20WS%20%3D%20WB.ActiveSheet%0A%20%20%20%20Set%20SH%20%3D%20WB.Worksheets.Item(sheet_no%20%2B%201)%0A%0A%20%20%20%20Dim%20output_folder%20As%20String%0A%20%20%20%20Dim%20image%20As%20Object%2C%20image_name%20As%20String%2C%20img_dimension%20As%20Variant%2C%20img_area%20As%20Variant%0A%20%20%20%20%0A%20%20%20%20output_folder%20%3D%20CurrentProject.Path%20%26amp%3B%20%22%5CTemp%5C%22%0A%0A%20%20%20%20For%20Each%20image%20In%20ActiveSheet.Shapes%0A%20%20%20%20%20%20%20%20image_name%20%3D%20image.TopLeftCell.Row%20%26amp%3B%20%22_%22%20%26amp%3B%20image.TopLeftCell.Column%0A%20%0A%20%20%20%20%20%20%20%20image.Select%0A%20%20%20%20%20%20%20%20With%20Selection.ShapeRange%0A%20%20%20%20%20%20%20%20%20%20%20%20.Fill.Visible%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20%20%20%20%20.Line.Visible%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20%20%20%20%20.Rotation%20%3D%200%23%0A%20%20%20%20%20%20%20%20%20%20%20%20.ScaleHeight%201%23%2C%20msoTrue%2C%20msoScaleFromTopLeft%0A%20%20%20%20%20%20%20%20%20%20%20%20.ScaleWidth%201%23%2C%20msoTrue%2C%20msoScaleFromTopLeft%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20With%20Selection.ShapeRange.pictureFormat%0A%20%20%20%20%20%20%20%20%20%20%20%20.CropLeft%20%3D%200%23%0A%20%20%20%20%20%20%20%20%20%20%20%20.CropRight%20%3D%200%23%0A%20%20%20%20%20%20%20%20%20%20%20%20.CropBottom%20%3D%200%23%0A%20%20%20%20%20%20%20%20%20%20%20%20.CropTop%20%3D%200%23%0A%20%20%20%20%20%20%20%20%20%20%20%20.TransparentBackground%20%3D%20msoFalse%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20Selection.CopyPicture%0A%20%20%20%20%20%20%20%20Set%20img_dimension%20%3D%20ActiveSheet.ChartObjects.Add(0%2C%200%2C%20image.Width%2C%20image.Height)%0A%20%20%20%20%20%20%20%20Set%20img_area%20%3D%20img_dimension.Chart%0A%20%20%20%20%20%20%20%20img_dimension.Activate%0A%20%20%20%20%20%20%20%20With%20img_area%0A%20%20%20%20%20%20%20%20%20%20%20%20.ChartArea.Select%0A%20%20%20%20%20%20%20%20%20%20%20%20.Paste%0A%20%20%20%20%20%20%20%20%20%20%20%20.Export%20(output_folder%20%26amp%3B%20%22%5C%22%20%26amp%3B%20image_name%20%26amp%3B%20%22.jpg%22)%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20img_dimension.Delete%0A%20%20%20%20%20%20%20%20%0Asuccessivo%3A%0A%20%20%20%20Next%0A%20%20%20%20%0A%20%20%20%20Set%20XL%20%3D%20Nothing%0A%20%20%20%20Set%20WB%20%3D%20Nothing%0A%20%20%20%20Set%20WS%20%3D%20Nothing%0A%20%20%20%20Set%20SH%20%3D%20Nothing%0A%20%20%20%20%0AExit%20Sub%0A%20%20%20%20%0Aerr_ExportMyPicture%3A%0A%20%20%20%20MsgBox%20%22the%20immage%3A%20%22%20%26amp%3B%20image_name%20%26amp%3B%20%22%20was%20not%20exported.%22%0A%20%20%20%20%0A%20%20%20%20%0AResume%20successivo%3C%2FFILE%3E%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22VIiyi%22%3E%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3EThanks%20a%20lot%20for%20the%20tip%3C%2FSPAN%3E%3C%2FSPAN%3E%20%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3EMarco%20Dell'Oca%3C%2FSPAN%3E%3C%2FSPAN%3E%3C%2FSPAN%3E%20%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E
New Contributor

Using MS Access and Vba, I need to extract images contained in an excel file, sheet n. 2 and save them in a directory on the pc.
Where can I find information?
Thanks in advance

Marco Dell'Oca

5 Replies

@Marco_DellOca 

I use this in Excel (VBA). This subroutine exports pictures by first converting them to a chart object that can be saved to a folder. You can either use this in Excel or port it to Access VBA:

Sub SaveAllPictures()
    Dim shPictures
    Set shPictures = ActiveWorkbook.Sheets(2)
    
    Dim oShape As Shape
    Dim strPictureName As String
    Dim oChartObject As ChartObject
    Dim oChart As Chart
    
    For Each oShape In ActiveSheet.Shapes
        strPictureName = oShape.Name
        
        oShape.Select
        Selection.ShapeRange.PictureFormat.Contrast = 0.5
        Selection.ShapeRange.PictureFormat.Brightness = 0.5
        Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
        Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.Rotation = 0#
        Selection.ShapeRange.PictureFormat.CropLeft = 0#
        Selection.ShapeRange.PictureFormat.CropRight = 0#
        Selection.ShapeRange.PictureFormat.CropTop = 0#
        Selection.ShapeRange.PictureFormat.CropBottom = 0#
        Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft

        Application.Selection.CopyPicture
        Set oChartObject = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height)
        Set oChart = oChartObject.Chart
        oChartObject.Activate
        With oChart
            .ChartArea.Select
            .Paste
            .Export ("..." & strPictureName & ".jpg") '<-- add your folder here
        End With
        oChartObject.Delete
    Next
    
    Set shPictures = Nothing
End Sub

 

Best regards,

Tieme

best response confirmed by Marco_DellOca (New Contributor)
Solution

@Tieme Woldman

thanks Tieme,

I solved the problem by reading the Excel file from Access in this way:

 

 

    Dim XL As Excel.Application
    Dim WB As Excel.Workbook
    Dim WS As Excel.Worksheet
    Dim SH As Excel.Worksheet
    
    Set XL = CreateObject("Excel.Application")
    Set WB = XL.Workbooks.Open(<file Excel path>)
    XL.Visible = False
    WB.Worksheets(sheet_no + 1).Select
    Set WS = WB.ActiveSheet
    Set SH = WB.Worksheets.Item(sheet_no + 1)

    Dim output_folder As String
    Dim image As Object, image_name As String, img_dimension As Variant, img_area As Variant
    
    output_folder = CurrentProject.Path & "\Temp\"

    For Each image In ActiveSheet.Shapes
        image_name = image.TopLeftCell.Row & "_" & image.TopLeftCell.Column
 
        image.Select
        With Selection.ShapeRange
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .Rotation = 0#
            .ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
            .ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
        End With
        With Selection.ShapeRange.pictureFormat
            .CropLeft = 0#
            .CropRight = 0#
            .CropBottom = 0#
            .CropTop = 0#
            .TransparentBackground = msoFalse
        End With
        Selection.CopyPicture
        Set img_dimension = ActiveSheet.ChartObjects.Add(0, 0, image.Width, image.Height)
        Set img_area = img_dimension.Chart
        img_dimension.Activate
        With img_area
            .ChartArea.Select
            .Paste
            .Export (output_folder & "\" & image_name & ".jpg")
        End With
        img_dimension.Delete
        
successivo:
    Next
    
    Set XL = Nothing
    Set WB = Nothing
    Set WS = Nothing
    Set SH = Nothing
    
Exit Sub
    
err_ExportMyPicture:
    MsgBox "the immage: " & image_name & " was not exported."
    
    
Resume successivo

 

 

 

Thanks a lot for the tip Marco Dell'Oca  

It is a bit odd to confirm your own answer as best response as responses come from contributors who help.
you are right, I was wrong and I could not change the choice.
I'm sorry, how can I fix it?
Pardon,
I tried again but couldn't change my choice.

Endless excuses.