На листе располагается множество автофигур одиночных и сгруппированных в "группы", а также диаграммы.
Как макросом - при щелчке на кнопку - заставить сохранится только сгруппированные блоки фигур (пропустив одиночные) и диаграммы - в виде jpg - в ту же папку, где лежит файл?
Здравствуйте, господа. Помогите найти решение.
На листе располагается множество автофигур одиночных и сгруппированных в "группы", а также диаграммы.
Как макросом - при щелчке на кнопку - заставить сохранится только сгруппированные блоки фигур (пропустив одиночные) и диаграммы - в виде jpg - в ту же папку, где лежит файл?rotten41
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]
[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