VBA 巨集取出 Excel 中的圖檔

出至: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.

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

發表迴響

在下方填入你的資料或按右方圖示以社群網站登入:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / 變更 )

Twitter picture

You are commenting using your Twitter account. Log Out / 變更 )

Facebook照片

You are commenting using your Facebook account. Log Out / 變更 )

Google+ photo

You are commenting using your Google+ account. Log Out / 變更 )

連結到 %s