Foxtable(狐表)用户栏目专家坐堂 → 如何提取excel中的图片


  共有2836人关注过本帖树形打印复制链接

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

帅哥哟,离线,有人找我吗?
有点甜
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/14 18:19:00 [显示全部帖子]

以下是引用rjh4078在2019/6/14 17:41:00的发言:
如题 以前将图纸保存到了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


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/17 19:20:00 [显示全部帖子]

以下是引用rjh4078在2019/6/17 18:26:00的发言:
老师  现在可以获取部分excel图片 又有新的问题  有部分文档是有密码保护只能只读的 读取的时候需要一个个点 有没有什么方法去掉,还有一个 如果我想获取单元格区间内的图片 要怎么处理
比如获取第4行到第15行之间的

 

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

 


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/18 9:32:00 [显示全部帖子]

以下是引用rjh4078在2019/6/18 6:45:00的发言:
感谢老师半夜还在解答
现在红色部分报错 提示不存在对象 
蓝色这段代码可能有有问题  我的本意是只截取29行以内的图片 


[此贴子已经被作者于2019/6/18 6:47:19编辑过]

 

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

 

Dim rng = s.TopLeftCell

msgbox(rng.address)

 

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


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/18 9:32:00 [显示全部帖子]

以下是引用rjh4078在2019/6/18 6:57:00的发言:
另外老是报这个错误 常来自 HRESULT:0x800A03EC

 

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

 


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/18 9:52:00 [显示全部帖子]

以下是引用rjh4078在2019/6/18 7:01:00的发言:
还有个问题  另存的时候能设置图片大小吗 在excel里插入的 1080*900的图片 缩小了 提取出来也是缩小后的 能还原成1080*900吗?

 

打开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


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/18 12:04:00 [显示全部帖子]

弹出类型看看

 

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


 回到顶部