如何提取excel中的图片 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

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

共有2873人关注过本帖树形打印复制链接主题：如何提取excel中的图片

有点甜

小大 31楼 | 信息 | 搜索 | 邮箱 | 主页 | 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行，那就退出循环。

有点甜

小大 32楼 | 信息 | 搜索 | 邮箱 | 主页 | 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

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

有点甜

小大 33楼 | 信息 | 搜索 | 邮箱 | 主页 | 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

rjh4078

小大 34楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：狐精帖子：3353 积分：24705 威望：0 精华：0 注册：2012/3/26 21:47:00

Post By：2019/6/18 12:01:00 [只看该作者]

NET Framework 版本：2.0.50727.9040

Foxtable 版本：2019.4.12.1

错误所在事件：窗口,窗口1,Button1,Click

详细错误信息：

RelativeToOriginalSize 只应用于图片或 OLE 对象。

提示这个错误

rjh4078

小大 35楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：狐精帖子：3353 积分：24705 威望：0 精华：0 注册：2012/3/26 21:47:00

Post By：2019/6/18 12:03:00 [只看该作者]

---------------------------

版本:2019.4.12.1

---------------------------

代码执行出错，错误信息：

System.Runtime.InteropServices.COMException (0x800A03EC): 异常来自 HRESULT:0x800A03EC

在 Microsoft.VisualBasic.CompilerServices.LateBinding.InternalLateCall(Object o, Type objType, String name, Object[] args, String[] paramnames, Boolean[] CopyBack, Boolean IgnoreReturn)

在 Microsoft.VisualBasic.CompilerServices.NewLateBinding.LateCall(Object Instance, Type Type, String MemberName, Object[] Arguments, String[] ArgumentNames, Type[] TypeArguments, Boolean[] CopyBack, Boolean IgnoreReturn)

在 UserCode.Test()

---------------------------

确定

---------------------------

有点甜

小大 36楼 | 信息 | 搜索 | 邮箱 | 主页 | 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

下一主题 >> << 上一主题

总数 36 上一页 1 2 3 4

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