原文链接:http://www.vbforums.com/showthread.php?538529-Export-an-Image-from-Excel-Sheet-to-Hard-Drive
Option Explicit
'You need to select a picture before running this code
'else it will give you error'
Sub PictureExport()
Dim TempChart As String, Picture2Export As String
Dim PicWidth As Long, PicHeight As Long
Picture2Export = Selection.Name
'Store the picture's height and width in a variable
With Selection
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With
'Add a temporary chart in sheet1
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = 0
TempChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
'Change the dimensions of the chart to suit your need
With .Shapes(TempChart)
.Width = PicWidth
.Height = PicHeight
End With
'Copy the picture
.Shapes(Picture2Export).Copy
'Paste the picture in the chart
With ActiveChart
.ChartArea.Select
.Paste
End With
'Finally export the chart
.ChartObjects(1).Chart.Export Filename:="Sample.jpg", FilterName:="jpg"
'Destroy the chart. You may want to delete it...
.Shapes(TempChart).Cut
End With
End Sub