求助：VBA批量无损导出图片，找遍全网也没找到答案

小fisher

当用户对工作表中的图片进行复制操作时，Excel在后台对图片进行了多种处理，并把处理后的各种格式内容放到了剪贴板中，其中一种格式名称为"Excel 2007 Internal Shape"，将其中数据保存为文件后发现其本质上是zip压缩文件，有点类似于.xlsx，见下图：

其中的\clipboard\media\Image1.xxx与.xlsx文件中\xl\media\image#.xxx的内容一模一样，只要把它解压出来就可以达到无损导出图片的目的。详见附件 批量导出图片（无损导出方法）.rar (459.22 KB, 下载次数: 107)

2023-3-24 11:28 上传

点击文件名下载附件

smiletwo

perfect131

小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时，Excel在后台对图片进行了多种处理，并把处理后的各种格式内容放 ...

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

aman1516

smiletwo 发表于 2023-3-24 14:13

   .ScaleHeight 1, msoCtrue
   .ScaleWidth 1, msoCtrue
与
   .ScaleHeight 2, msoFalse, msoScaleFromBottomRight
有什么区别，各有相关的具体说明吗？

小fisher

perfect131 发表于 2023-3-24 17:12
学习了，但好像对 切割 的图片不管用 ，zip 解压也不管用 ，只能 htm 或其他方法
文件就是分享的附件
h ...

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

ivccav

小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时，Excel在后台对图片进行了多种处理，并把处理后的各种格式内容放 ...

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

小fisher

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

ii_snow

小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时，Excel在后台对图片进行了多种处理，并把处理后的各种格式内容放 ...

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

高度保密

小fisher 发表于 2023-3-24 12:00
当用户对工作表中的图片进行复制操作时，Excel在后台对图片进行了多种处理，并把处理后的各种格式内容放 ...

我这里win7，excel2016，导出不成功，显示导出0张图片