【excel导出图片】并按同行固定列数值命名

马甲大队长

看了几个帖子，也试着自己改了下，但是改出来完全不对。。。。
我想达到的效果是表格里面的图片，导出来，越接近原图片分辨率越好，尽量不压缩。
图片的命名以文字列的为内容为准。

我的版本是excel 2016；
请问有没有大神给我一段宏并解释下参数，万分感谢！

导出图片-风扇 180625.rar (210.97 KB, 下载次数: 167)

2018-6-25 14:48 上传

点击文件名下载附件

活在理想的世界

a方案创建chart，复制图片，粘贴图片到新chart，带出chart到指定路径，删除chart。

b方案，另存工作簿为网页，将文件移动至指定路径。
至于图片命名是最简单的了，根本不是事。

活在理想的世界

这是A方案，至于B方案。。。。自己手动操作一下吧。

1. Sub d()
   
2. Dim arr(), c As Chart, shp As Shape
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. i = 1
   
5. For Each shp In Sheet1.Shapes
   
6.     i = i + 1: shp.CopyPicture
   
7.     Set c = Sheet1.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
   
8.     c.Paste
   
9.     c.Export ThisWorkbook.Path & "" & arr(i, 1) & ".jpg"
   
10. Next
    
11. For Each shp In Sheet1.Shapes
    
12.     If shp.Type = msoChart Then shp.Delete
    
13. Next
    
14. End Sub

复制代码

jjmysjg

活在理想的世界 发表于 2018-6-25 16:18
这是A方案，至于B方案。。。。自己手动操作一下吧。

目的实现。
但是在Excel界面添了一个宏的运行窗体按钮，运行提示错误（但到处已完成）

活在理想的世界

jjmysjg 发表于 2018-6-25 16:38
目的实现。
但是在Excel界面添了一个宏的运行窗体按钮，运行提示错误（但到处已完成）

我的附件里运行正常。

活在理想的世界

jjmysjg 发表于 2018-6-25 16:38
目的实现。
但是在Excel界面添了一个宏的运行窗体按钮，运行提示错误（但到处已完成）

把你运行出错的附件发我，我看看哪里出差了。

目的实现但代码报错一般都是代码名称的问题。

jjmysjg

活在理想的世界 发表于 2018-6-25 16:45
把你运行出错的附件发我，我看看哪里出差了。

目的实现但代码报错一般都是代码名称的问题。

麻烦老师看看

活在理想的世界

jjmysjg 发表于 2018-6-25 17:02
麻烦老师看看

知道问题出在什么地方吗？我一运行代码看到下标越界就知道原因了。

活在理想的世界

1. Sub d()
   
2. Dim arr(), c As Chart, shp As Shape
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. i = 1
   
5. For Each shp In Sheet1.Shapes
   
6.     If shp.Type = msoPicture Then
   
7.         i = i + 1: shp.CopyPicture
   
8.         Set c = Sheet1.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
   
9.         c.Paste
   
10.         c.Export ThisWorkbook.Path & "" & arr(i, 1) & ".jpg"
    
11.     End If
    
12. Next
    
13. For Each shp In Sheet1.Shapes
    
14.     If shp.Type = msoChart Then shp.Delete
    
15. Next
    
16. End Sub

复制代码

活在理想的世界

因为窗体控件本身也是shape对象，之前我写的没有加窗体控件，所以FOR EACH 循环shape对象是对的。
但是你加了窗体就不对了，因为对象就会是3而数组本身只有2（因为图片只有2张），所以就会下标越界。

如果想不出错就加一个判断条件，这个判断条件就是只对图片本身进行Copy。

仅此而已。