将所有图片中的所有形状另存为png文件

时间:2019-06-14 10:37:54

标签: excel vba

我一直在寻找看似简单的答案,但找不到可以使用的答案。我需要在excel中选择一个分组形状,并将其保存为名称XX.PNGIN一个特定的文件位置。

我厌倦了下面的代码,但是它不起作用。

选择一组形状真的很难吗?

谢谢

下面的代码很累,还有其他几件事

Public Sub AddChartObjects()

    Dim chtObj As ChartObject
    Dim ment As Variant
        With ThisWorkbook.Worksheets("SUMMARY INFOGRAPHIC")
            .Activate

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

            'resize chart to picture size
            chtObj.Width = .Shapes().Group("group 17").Width
            chtObj.Height = .Shapes().Group("group 17").Height

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

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

            ActiveChart.Export Filename:="I:\Blenheim House\Analytics\North Region Report Library\Friends & Family\downloads\June\final versions\filename.jpg", FilterName:="jpg"

            chtObj.Delete
        End With
End Sub

1 个答案:

答案 0 :(得分:1)

假设您已将形状组命名为“组17”,则可以使用Shapes对象简单地引用它们。

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

此外,您的代码可以如下重写...

Public Sub AddChartObjects()

    Dim chtObj As ChartObject

        With ThisWorkbook.Worksheets("SUMMARY INFOGRAPHIC")
            .Activate

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

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

            .Shapes("group 17").Copy

            With chtObj
                .Activate
                With .Chart
                    .Paste
                    .Export Filename:="I:\Blenheim House\Analytics\North Region Report Library\Friends & Family\downloads\June\final versions\filename.jpg", FilterName:="jpg"
                End With
                .Delete
            End With
        End With

End Sub

希望这会有所帮助!