批量导出选择的图片

aecn

chzsh 发表于 2023-2-4 05:52
我比了一下，一样的，为什么说没有if块呢

ElseIF 后多抄了一句 For Each shp In Selection

pc087

不用费劲了，导出图片，用wps的JSA会方便很多，shape有直接的SaveAsPicture方法

chzsh

Sub save_pic() '导出所有图片
Dim shap As Shape
Dim i As Integer
With ActiveSheet
    For i = 1 To .Shapes.Count
        Set shap = .Shapes(i)
        shap.Copy
    With .ChartObjects.Add(0, 0, shap.Width, shap.Height).Chart
        .Parent.Select
        .Paste
        .Export ThisWorkbook.Path & "\" & i & ".jpg"
        .Parent.Delete
    End With
    Next
End With
End Sub
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

smiletwo

chzsh 发表于 2023-2-4 05:52
我比了一下，一样的，为什么说没有if块呢

第二块没有for each ，你用了，而且没用next配对
抄作业不及格

smiletwo

chzsh 发表于 2023-2-4 16:11
Sub save_pic() '导出所有图片
Dim shap As Shape
Dim i As Integer

总结的不错
有地方抄错了！是shp不是shap

少如

chzsh 发表于 2023-2-4 16:11
Sub save_pic() '导出所有图片
Dim shap As Shape
Dim i As Integer

导出选中图片不成功，请见附件：
批量导出选择的图片.zip (375.95 KB, 下载次数: 16)

2023-2-5 17:10 上传

点击文件名下载附件

smiletwo

少如 发表于 2023-2-5 17:10
导出选中图片不成功，请见附件：

抄作业不及格

kaka1295

感谢各位大神，问题圆满解决，小弟感激不尽！

smiletwo

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

直接送花更好

少如

smiletwo 发表于 2023-2-6 10:25
抄作业不及格

谢谢老师：
学生不懂VBA，照抄代码后仍不成功。
劳架老师帮忙把学生的附件改好，发上来吧。
非常感谢老师的帮助！
批量导出选择的图片 - 副本.zip (376.39 KB, 下载次数: 10)

2023-2-6 15:28 上传

点击文件名下载附件