批量导出选择的图片

smiletwo

少如 发表于 2023-2-6 15:28
谢谢老师：
学生不懂VBA，照抄代码后仍不成功。
劳架老师帮忙把学生的附件改好，发上来吧。

图中已经标示出来了：shap换成shp

少如

smiletwo 发表于 2023-2-6 17:09
图中已经标示出来了：shap换成shp

Sub demo() '导出选中图片
   Dim i, shp As Object
   On Error GoTo AA
With ActiveSheet
    If Selection.ShapeRange.Count > 1 Then
         For Each shp In Selection
            i = i + 1
            shp.Copy
            With .ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
                .Parent.Select
                .Paste
                .Export ThisWorkbook.Path & "\AAA\" & i & ".jpg"
                .Parent.Delete
            End With
         Next
      
   
       ElseIf Selection.ShapeRange.Count = 1 Then
            Set shp = Selection.ShapeRange(1)
           
                shp.Copy
                With .ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
                    .Parent.Select
                    .Paste
                    .Export ThisWorkbook.Path & "\AAA\ 1.jpg"
                    .Parent.Delete
            End With
      End If
      
    End With
    Exit Sub
AA:
MsgBox "请选择要保存的图形！"

End Sub

请教还哪里不对？请见附件。谢谢！
批量导出选择的图片 - 副本.zip (379.58 KB, 下载次数: 13)

2023-2-6 21:29 上传

点击文件名下载附件

少如

kaka1295 发表于 2023-2-6 13:14
感谢各位大神，问题圆满解决，小弟感激不尽！

楼主：能否将您 '圆满解决' 的附件发上来分亨一下？
谢谢！

smiletwo

少如 发表于 2023-2-6 21:29
Sub demo() '导出选中图片
   Dim i, shp As Object
   On Error GoTo AA

建立相应的文件夹了吗？

smiletwo

少如 发表于 2023-2-6 21:29
Sub demo() '导出选中图片
   Dim i, shp As Object
   On Error GoTo AA

不能设置按钮，按钮本身也是图片，点击时，选择发生变化。选择图片后直接运行代码

smiletwo

不能用按钮，否则点击按钮执行代码时，sheet失去焦点，选择对象发生不确定的变化（实际情况是把所有的图片【含按钮】都导出来了）。
上附件

少如

smiletwo 发表于 2023-2-8 15:28
不能用按钮，否则点击按钮执行代码时，sheet失去焦点，选择对象发生不确定的变化（实际情况是把所有的图片 ...

请教；选择图片后如何 “直接运行代码”？
谢谢！

smiletwo

少如 发表于 2023-2-8 20:38
请教；选择图片后如何 “直接运行代码”？
谢谢！

alt+F11，打开代码 F5运行。
就是选择要导出的图片后，避免再次操作sheet中的对象。