导出图片Excel VBA

Question

我在尝试从工作簿中选择和导出所有图片时遇到问题。我只想要照片。我需要选择并将它们全部保存为：“照片 1”、“照片 2”、“照片 3”等，位于工作簿的同一文件夹中。

我已经尝试过这段代码：

Sub ExportPictures()
Dim n As Long, shCount As Long

shCount = ActiveSheet.Shapes.Count
If Not shCount > 1 Then Exit Sub

For n = 1 To shCount - 1
With ActiveSheet.Shapes(n)
    If InStr(.Name, "Picture") > 0 Then
        Call ActiveSheet.Shapes(n).CopyPicture(xlScreen, xlPicture)
        Call SavePicture(ActiveSheet.Shapes(n), "C:\Users\DYNASTEST-01\Desktop\TEST.jpg")
    End If
End With
Next

End Sub

Answer 1

罗斯的方法效果很好，但使用带有图表的添加方法会强制离开当前激活的工作表...您可能不想这样做。

为了避免这种情况，您可以使用 ChartObject

Public Sub AddChartObjects()

    Dim chtObj As ChartObject

        With ThisWorkbook.Worksheets("A")

            .Activate

            Set chtObj = .ChartObjects.Add(100, 30, 400, 250)
            chtObj.Name = "TemporaryPictureChart"

            'resize chart to picture size
            chtObj.Width = .Shapes("TestPicture").Width
            chtObj.Height = .Shapes("TestPicture").Height

            ActiveSheet.Shapes.Range(Array("TestPicture")).Select
            Selection.Copy

            ActiveSheet.ChartObjects("TemporaryPictureChart").Activate
            ActiveChart.Paste

            ActiveChart.Export Filename:="C:\TestPicture.jpg", FilterName:="jpg"

            chtObj.Delete

        End With

End Sub