Apr 29 2021 06:42 AM
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
Jun 10 2021 04:49 AM
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
Jun 10 2021 09:08 AM
Solutionthanks 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
Jun 10 2021 09:42 AM
Jun 10 2021 10:17 AM
Jun 10 2021 10:20 AM
Jun 10 2021 09:08 AM
Solutionthanks 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