ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: ii_snow

[求助] 求助:VBA批量无损导出图片,找遍全网也没找到答案

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-3-24 12:00 | 显示全部楼层

当用户对工作表中的图片进行复制操作时,Excel在后台对图片进行了多种处理,并把处理后的各种格式内容放到了剪贴板中,其中一种格式名称为"Excel 2007 Internal Shape",将其中数据保存为文件后发现其本质上是zip压缩文件,有点类似于.xlsx,见下图:
无标题.png
其中的\clipboard\media\Image1.xxx与.xlsx文件中\xl\media\image#.xxx的内容一模一样,只要把它解压出来就可以达到无损导出图片的目的。详见附件 批量导出图片(无损导出方法).rar (459.22 KB, 下载次数: 107)

评分

4

查看全部评分

TA的精华主题

TA的得分主题

发表于 2023-3-24 14:13 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2023-3-24 17:12 | 显示全部楼层
本帖最后由 perfect131 于 2023-3-24 18:17 编辑
小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时,Excel在后台对图片进行了多种处理,并把处理后的各种格式内容放 ...

学习了,但好像对 切割 的图片不管用 ,zip 解压也不管用 ,只能 htm 或其他方法
文件就是分享的附件
https://club.excelhome.net/thread-1648005-1-1.html

TA的精华主题

TA的得分主题

发表于 2023-3-24 21:21 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

   .ScaleHeight 1, msoCtrue
   .ScaleWidth 1, msoCtrue

   .ScaleHeight 2, msoFalse, msoScaleFromBottomRight
有什么区别,各有相关的具体说明吗?



TA的精华主题

TA的得分主题

发表于 2023-3-25 08:05 | 显示全部楼层
perfect131 发表于 2023-3-24 17:12
学习了,但好像对 切割 的图片不管用 ,zip 解压也不管用 ,只能 htm 或其他方法
文件就是分享的附件
h ...

对切割的图片,可以复制->根据需要选择性粘贴为png/jpeg/gif图片->复制新图片,再从剪贴板中找,全程可以用代码自动实现。
这个方法不是从本地文件中读取,所以和文件本身的格式没关系,推测只要office版本在2007以上,对xls仍然适用。

TA的精华主题

TA的得分主题

发表于 2023-3-25 16:14 | 显示全部楼层
小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时,Excel在后台对图片进行了多种处理,并把处理后的各种格式内容放 ...




有个问题,如果图片放置位置不是很规范,不能统一地通过shp.TopLeftCell或者shp.BottomRightCell确定图片下方单元格,能否用矩形图片中心点的位置判断图片放在哪个单元格,如何实现。

TA的精华主题

TA的得分主题

发表于 2023-3-26 00:24 | 显示全部楼层
ivccav 发表于 2023-3-25 16:14
有个问题,如果图片放置位置不是很规范,不能统一地通过shp.TopLeftCell或者shp.BottomRightCell确 ...

Sub test()
    Dim shp As Shape, rng As Range
    Dim centerX As Single, centerY As Single
   
    Set shp = Sheet1.Shapes(1)
    centerX = shp.Left + shp.Width / 2
    centerY = shp.Top + shp.Height / 2
   
    Set rng = shp.TopLeftCell
    Do While rng.Top + rng.Height < centerY
        Set rng = rng.Offset(1, 0)
    Loop
    Do While rng.Left + rng.Width < centerX
        Set rng = rng.Offset(0, 1)
    Loop
   
    MsgBox "Shapes(1)中心点位于" & rng.Address & "单元格"
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-5-12 09:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时,Excel在后台对图片进行了多种处理,并把处理后的各种格式内容放 ...

一直在忙,这段时间出问题的文件都是我手工帮他们导出的图片,今天上来看,大佬太强大了,代码我还没看懂,但至少导出来的图片确实就是我要的结果,膜拜,我要好好研究一下,再三感谢!!!

TA的精华主题

TA的得分主题

发表于 2023-5-21 10:13 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时,Excel在后台对图片进行了多种处理,并把处理后的各种格式内容放 ...

我这里win7,excel2016,导出不成功,显示导出0张图片
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-16 07:54 , Processed in 0.046201 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表