Сохранение всех диаграмм и групповых автофигур с листа-в jpg

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение всех диаграмм и групповых автофигур с листа-в jpg (Макросы/Sub)

rotten41

Дата: Четверг, 27.04.2017, 17:59 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 163

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте, господа.
Помогите найти решение.

На листе располагается множество автофигур одиночных и сгруппированных в "группы", а также диаграммы.

Как макросом - при щелчке на кнопку - заставить сохранится только сгруппированные блоки фигур (пропустив одиночные) и диаграммы - в виде jpg - в ту же папку, где лежит файл?

К сообщению приложен файл: 21-564.xls (86.5 Kb)

Ответить

wild_pig

Дата: Четверг, 27.04.2017, 20:25 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 516

Репутация: 97 ±

Замечаний: 0% ±

2003, 2013

[vba]

Код

Sub nnn()
    Dim pic As Shape
    Dim nm$
'-----------------------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveSheet
        For Each pic In .Shapes
            If pic.Type = 3 Or pic.Type = 6 Then
                pic.Copy
                nm = ThisWorkbook.Path & "\" & pic.Name & ".jpg"
                With .ChartObjects.Add(0, 0, pic.Width, pic.Height).Chart
                    .ChartArea.Border.LineStyle = 0
                    .Parent.Select
                    .Paste
                    .Export Filename:=nm, FilterName:="JPG"
                    .Parent.Delete
                End With
            End If
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Beep
End Sub

[/vba]