主题：如何提取excel中的图片

参考代码

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\Test.xlsx")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
ws.Activate
For Each s As object In ws.shapes
    s.CopyPicture(Appearance:=1, Format:=2)
    ClipBoard.GetImage.save("d:\test" & s.name & ".jpg")
Next
app.visible = True

1、你需要知道密码，才能打开。http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=105513&skin=0

2、循环每一个 ws.shapes，判断其单元格位置，如

Dim rng = s.TopLeftCell

msgbox(rng.address)

3、如果文件比较多，试试多线程 http://www.foxtable.com/mobilehelp/scr/3268.htm

循环每一个 ws.shapes，判断其单元格位置，如

Dim rng = s.TopLeftCell

msgbox(rng.address)

如果地址大于29行，那就退出循环。

做个出错的实例发上来测试。

打开excel，看看图片的属性，看看原始尺寸，如果可以得到1080*900的大小，就可以还原，否则，不能还原的，因为你缩小的时候，就对图片修改了尺寸。

测试代码

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\Test.xlsx")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
ws.Activate
For Each s As object In ws.shapes
    s.ScaleHeight(1, True)
    s.ScaleWidth(1, True)
    s.CopyPicture
    Dim c = Ws.ChartObjects.Add(0,0,s.width, s.height)
    c.chart.paste
    c.chart.Export("d:\test" & s.name & ".jpg")
    c.Delete
Next
app.visible = True

弹出类型看看

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\t.xlsx")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
ws.Activate
For Each s As object In ws.shapes
msgbox(s.Type)
    s.ScaleHeight(1, True)
    s.ScaleWidth(1, True)
    s.CopyPicture
    Dim c = Ws.ChartObjects.Add(0,0,s.width, s.height)
    c.chart.paste
    c.chart.Export("d:\test" & s.name & ".jpg")
    c.Delete
Next
app.visible = True