Friday, August 22, 2008

VBA - Extract Pictures from Excel

Last month, I have written Excel Automation Using VBScript. Today this post is to extract Pictures from Excel. Generally We can not use Export method for pictures. But we can use for Excel charts. I tried to extract our SVG chart image by macro and I succeed on it. I got help from Export pictures from Excel Below I've given the VBA Macro code.

VBA Macro - To extract Picture from Excel

Sub GetFirstPicture() Dim sCurrPath As String Dim aWorkSheet As Excel.Worksheet Dim aShape As Excel.Shape Dim aShapeChart As Excel.Shape Dim aPicture As Variant Dim aChart As Excel.Chart Dim sCurrentSheet As String Dim aImage As Variant Dim iIndex As Integer Dim iShapeCount As Integer Dim MyChart As String, MyPicture As String Dim PicWidth As Long, PicHeight As Long Dim sChartJpg As String Dim sChartGif As String Dim sChartBmp As String 'On Error GoTo ErrHandler On Error Resume Next Application.ScreenUpdating = False sCurrPath = "D:\VB\MyTrials\ChartExpFromXL" sChartJpg = "D:\VB\MyTrials\ChartExpFromXL.jpg" sChartGif = "D:\VB\MyTrials\ChartExpFromXL.gif" sChartBmp = "D:\VB\MyTrials\ChartExpFromXL.bmp" Set aWorkSheet = ActiveWorkbook.ActiveSheet sCurrentSheet = aWorkSheet.Name 'MsgBox CStr(msoTrue) + " value for MsoTrue" ' MsoTrue equals to -1 MsgBox "Shapes count " + CStr(aWorkSheet.Shapes.Count) For iIndex = 1 To aWorkSheet.Shapes.Count Set aShape = aWorkSheet.Shapes(iIndex) MyPicture = aShape.Name MsgBox aShape.Name + " Name, " + Str(aShape.Type) 'Picture 1 Name, 13 If Left(aShape.Name, 7) = "Picture" Then With aShape PicHeight = .Height PicWidth = .Width End With 'Set aChart = aWorkSheet.ChartObjects(1) Set aChart = ActiveWorkbook.Charts.Add ActiveWorkbook.ActiveChart.Location Where:=xlLocationAsObject, Name:=sCurrentSheet iShapeCount = aWorkSheet.Shapes.Count Set aShapeChart = aWorkSheet.Shapes(iShapeCount) MyChart = aShapeChart.Name '"Chart " & Str(aWorkSheet.Shapes.Count) aShapeChart.Width = PicWidth aShapeChart.Height = PicHeight With aWorkSheet aShape.Copy With ActiveChart 'aChart .ChartArea.Select .Paste End With .ChartObjects(1).Chart.Export Filename:=sChartJpg, FilterName:="jpg", Interactive:=True .ChartObjects(1).Chart.Export Filename:=sChartGif .ChartObjects(1).Chart.Export Filename:=sCurrPath & ".png" 'Not working .ChartObjects(1).Chart.Export Filename:=sChartBmp, FilterName:="bmp" aShapeChart.Cut End With Application.ScreenUpdating = True MsgBox "Completed." Exit Sub End If Next MsgBox "Completed." Exit Sub ErrHandler: MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source Err.Clear ' Clear the error. End Sub

2 comments:

Flagor5 said...

Awesome!
This is my delima. I have an image..say circle.jpg that I would like to use on the userform. But this spread sheet I am using is not located on any server. I would like to add the image to my vba userform, but won't be able to make sure everyone has the image on thier comp, so I won't be able to pull it from thier machine.
What I would like to do is to attach the image to the excel file then when the vba form is activated, pull the image from excel and put the image into the vba.
Your post will help tremendously for me to learn how to do this.
Rock On!
Robert ###(rflagor@yahoo.com)###

Palani Selvam said...

Good to know, my blog is worth for you..!