Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение всех диаграмм и групповых автофигур с листа-в jpg (Макросы/Sub)
Сохранение всех диаграмм и групповых автофигур с листа-в jpg
rotten41 Дата: Четверг, 27.04.2017, 17:59 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 0 ±
Замечаний: 0% ±

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

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

Как макросом - при щелчке на кнопку - заставить сохранится только сгруппированные блоки фигур (пропустив одиночные) и диаграммы - в виде jpg - в ту же папку, где лежит файл?
К сообщению приложен файл: 21-564.xls(86Kb)
 
Ответить
СообщениеЗдравствуйте, господа.
Помогите найти решение.

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

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

Автор - rotten41
Дата добавления - 27.04.2017 в 17:59
wild_pig Дата: Четверг, 27.04.2017, 20:25 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 91 ±
Замечаний: 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]


Сообщение отредактировал wild_pig - Пятница, 28.04.2017, 15:56
 
Ответить
Сообщение[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]

Автор - wild_pig
Дата добавления - 27.04.2017 в 20:25
rotten41 Дата: Четверг, 27.04.2017, 21:25 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
wild_pig, использовал ваш код.

Но он - только группы автофигур сохраняет, а диаграммы - нет.
 
Ответить
Сообщениеwild_pig, использовал ваш код.

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

Автор - rotten41
Дата добавления - 27.04.2017 в 21:25
wild_pig Дата: Четверг, 27.04.2017, 22:22 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 91 ±
Замечаний: 0% ±

2003, 2013
Ну так допишите, чтобы и диаграммы сохранял, делов то.
Поправил код выше.


Сообщение отредактировал wild_pig - Четверг, 27.04.2017, 22:26
 
Ответить
СообщениеНу так допишите, чтобы и диаграммы сохранял, делов то.
Поправил код выше.

Автор - wild_pig
Дата добавления - 27.04.2017 в 22:22
rotten41 Дата: Четверг, 27.04.2017, 22:43 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
wild_pig, огромное вам спасибо.
Теперь все заработало !
 
Ответить
Сообщениеwild_pig, огромное вам спасибо.
Теперь все заработало !

Автор - rotten41
Дата добавления - 27.04.2017 в 22:43
Фомулист Дата: Пятница, 28.04.2017, 14:22 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: -12 ±
Замечаний: 60% ±

Excel 2003
[vba]
Код
Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Beep
[/vba]

В начале писали точно такие же строки. Может нужно True? И скажите, пожалуйста, что значит Beep?


Терпение и труд всё перетрут!
 
Ответить
Сообщение
[vba]
Код
Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Beep
[/vba]

В начале писали точно такие же строки. Может нужно True? И скажите, пожалуйста, что значит Beep?

Автор - Фомулист
Дата добавления - 28.04.2017 в 14:22
wild_pig Дата: Пятница, 28.04.2017, 15:59 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 489
Репутация: 91 ±
Замечаний: 0% ±

2003, 2013
Цитата Фомулист, 28.04.2017 в 14:22, в сообщении № 6 ()
В начале писали точно такие же строки

При копировании первых строк не изменил значения. Исправил выше.
Beep - звуковой сигнал.
 
Ответить
Сообщение
Цитата Фомулист, 28.04.2017 в 14:22, в сообщении № 6 ()
В начале писали точно такие же строки

При копировании первых строк не изменил значения. Исправил выше.
Beep - звуковой сигнал.

Автор - wild_pig
Дата добавления - 28.04.2017 в 15:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение всех диаграмм и групповых автофигур с листа-в jpg (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!