Экспорт группы графических объектов (диаграмма + другие линии) из Excel 2012 - PullRequest
Новая
       31

Экспорт группы графических объектов (диаграмма + другие линии) из Excel 2012

0 голосов
/ 20 февраля 2012

У меня есть код VBA, который экспортирует активную диаграмму из Excel в формате PNG.

У меня есть несколько точек и линий, отмечающих некоторые важные данные, наложенные на мою диаграмму Excel, и они сгруппированы (выберите все объекты и диаграмму, щелкните правой кнопкой мыши -> Группировать).

Есть ли что-нибудь, чем я могу заменить 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

Ответы [ 2 ]

1 голос
/ 21 апреля 2015

Старый вопрос, который я знаю, но решение исходит из того факта, что диаграмма, сгруппированная с другими фигурами, становится объектом формы на листе. Так что вам действительно нужно получить ссылку на объект формы, который является группой, которую вы создали.

Однако для фигур не существует метода экспорта, поэтому вам нужно создать временную пустую диаграмму, скопировать в нее фигуру, экспортировать новую диаграмму, а затем удалить ее.

Шаги:

Получите объект формы и скопируйте его как рисунок 

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

Создайте новый chartobject с теми же размерами, что и исходная форма 

 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
0 голосов
/ 26 апреля 2018

Вот код, который работает для сохранения изображения группы фигур. Это модификация ответа Джереми, которая находит определенную группу (на основе заголовка [Alt Text], найденного в «Format Shape»). Подпрограмма сначала запускает определенный макрос (для обновления графа в группе). 

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
...