Question

我有VBA代码，可以用PNG格式从Excel导出活动图表。

我有一些点和线，标记了我的Excel图表上覆盖的一些重要数据，并将它们分组（选择所有对象和图表，右键单击 - ＆gt;组）。

我可以用ActiveChart替换ActiveChart（比如ActiveGroup或类似的东西）来导出整个东西，而不仅仅是图表。

Sub ExportChartToPNG()
'Take ActiveChart and copy it as a GIF image to the same directory as the Workbook is in and name it with the Chart_Title with spaces replaced with underscores.
Dim chtCopyChart As Chart, sCurrentDirectory As String, sFileName As String
Dim x As Integer, CellCharacter As String
Dim sInteractive As Boolean

Set chtCopyChart = ActiveChart
sCurrentDirectory = ActiveWorkbook.Path
sFileName = chtCopyChart.ChartTitle.Text
sFileName = InputBox("Enter filename for export:", "Export object", sFileName)

For x = 1 To Len(sFileName)
    CellCharacter = Mid(sFileName, x, 1)
    If CellCharacter Like "[</*\?%]" Then
        sFileName = Replace(sFileName, CellCharacter, "_", 1) ', Replaces all illegal filename characters with "_"
    End If
If Asc(CellCharacter) <= 32 Then
    sFileName = Replace(sFileName, CellCharacter, "_", 1) ' Replaces all non printable characters with "_"
End If

Next

sFileName = sFileName & ".png"
sFileName = sCurrentDirectory & "\" & sFileName
sInteractive = True

chtCopyChart.Export Filename:=sFileName, FilterName:="PNG", Interactive:=sInteractive

MsgBox "Chart copied to " & sFileName, vbOKOnly, "Success!"

End Sub

Answer 1

老问题我知道，但解决方案来自于与其他形状分组的图表在工作表中成为形状对象。所以你真正需要做的是获得对你创建的组的形状对象的引用。

但是，形状上没有导出方法，因此您需要创建临时空白图表，将形状复制到其中，导出新图表，然后将其删除。

步骤如下：

获取形状对象并将其复制为图片

set myshape = Sheet24.Shapes("shapename")
myshape.CopyPicture

创建一个与源形状尺寸相同的新图表对象

 set chtObj = Sheets24.ChartObjects.Add(myshape.Left, myshape.Top, myshape.Width, myshape.height)

将对象从剪贴板粘贴到新图表

chtObj.Chart.Paste

导出图表，根据需要删除现有文件

Kill fullpathandfilename    
chtObj.Chart.Export filename:=fullpathandfilename, Filtername:="PNG"

然后删除图表并清理对象。

chtObj.Delete
Set chtObj = nothing

Answer 2

以下是用于保存一组形状图像的代码。这是Jeremy的答案的修改，它找到了一个特定的组（基于'格式形状'下的[Alt Text]标题）。子操作首先运行特定的宏（以更新组中的图形）。

Global Const myFilePath = "C:\YourFolder\"    
Public Sub saveChart(ByVal sheetName As String, ByVal macroName As String, _
                            ByVal fileName As String, exportType As Integer)
        Dim wb As Workbook
        Dim ws As Worksheet
        Set wb = ThisWorkbook
        Set ws = Sheets(sheetName)
        ws.Activate
        Application.Run "'" & wb.Name & "'!VBAProject." & ws.CodeName & "." & macroName

        Select Case exportType
            Case 0 'standard chart
                Set objChrt = Sheets(sheetName).ChartObjects(1)
                Set myChart = objChrt.Chart
                myChart.Export fileName:=myFilePath & fileName, Filtername:="JPEG"
            Case 1 'Group of chart and other objects
                Dim sh As Shape
                Dim I As Integer
                Dim groupedName As String
                I = 1
                    'Find grouped shape in worksheet with Title of 'Export'
                For Each sh In ActiveSheet.Shapes
                    If sh.Type = 6 Then '6 indicates it's a group
                        If sh.Title = "Export" Then
                            Set myshape = sh
                            groupedName = sh.Name
                        End If
                    End If
                    I = I + 1
                Next
                    'Select and copy group
                ws.Shapes.Range(Array(groupedName)).Select
                Selection.CopyPicture
                    'Create temporary chart
                Set chtObj = ws.ChartObjects.Add( _
                            myshape.Left, myshape.Top, myshape.Width, myshape.Height)
                    'Select temporary chart and paste the Group
                chtObj.Select
                chtObj.Chart.Paste
                    'Export the image
                chtObj.Chart.Export fileName:=myFilePath & fileName, Filtername:="JPEG"
                    'Clean up
                chtObj.delete
                Set chtObj = Nothing
            Case Else
        End Select
        Set wb = Nothing
        Set ws = Nothing
    End Sub

从Excel 2012导出一组图形对象（图表+其他行）

2 个答案: