Экспорт всех диаграмм в формате PNG

#excel #vba #excel-2007

#excel #vba #excel-2007

Вопрос:

Я пытаюсь экспортировать все диаграммы в моем файле Excel в виде изображения PNG. Диаграммы не встроены в рабочие листы, а вместо этого были перемещены как новый лист при создании.

Не будучи знакомым с макросами VBA или Office, я попытался объединить что-то на основе примеров кода, которые я нашел в Интернете, но безуспешно.

Вот что я пробовал, что может работать с диаграммами, встроенными в рабочие листы, но не с автономными диаграммами:

 Private Sub ExportChartsButton_Click()
    Dim outFldr As String
    Dim ws As Worksheet
    Dim co As ChartObject

    outFldr = GetFolder(ActiveWorkbook.Path) 
    For Each ws In ActiveWorkbook.Worksheets
        For Each co In ws.ChartObjects
            co.Export outFldr amp; "" amp; ws.Name amp; ".png", "PNG"
        Next
    Next
End Sub
  

При нажатии кнопки, кажется, ничего не происходит.

Если я заменю внутренний цикл на MsgBox co.ChartObjects.Count , я получу 0 всплывающее окно для каждого из моих листов без диаграмм, поэтому я, очевидно, не перебираю нужные объекты (следовательно, нет диаграмм, поэтому ничего не происходит).

Итак, как мне выполнить итерацию по диаграммам, которые не встроены в рабочие листы?

Ответ №1:

Я нашел решение. Мне пришлось использовать ActiveWorkbook.Charts вместо .Worksheets .

 Private Sub ExportChartsButton_Click()
    Dim outFldr As String
    Dim wc As Chart
    Dim co As ChartObject

    outFldr = GetFolder(ActiveWorkbook.Path)
    If outFldr = "" Then
        MsgBox "Export Cancelled"
    Else
        For Each wc In ActiveWorkbook.Charts
            wc.Export outFldr amp; "" amp; wc.Name amp; ".png", "PNG"
        Next
    End If
End Sub
  

И для записи GetFolder() определяется как:

 Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select folder to export Charts to"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show = True Then sItem = .SelectedItems(1)
    End With
    GetFolder = sItem
    Set fldr = Nothing
End Function
  

Комментарии / предложения приветствуются.

Комментарии:

1. Спасибо, но я считаю, что могу принять свой собственный ответ только через 2 дня. Что хорошо, поскольку я не знаком с vba и приветствовал бы улучшения или лучшие решения.

2. Спасибо. Приятно знать, что я не ошибся.

Ответ №2:

Возможно, одним из самых простых способов экспорта на сегодняшний день является сохранение всей книги в виде веб-страницы. Затем Excel автоматически преобразует ваши диаграммы в формат PNG