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

Вход

Регистрация

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

 

= Мир MS Excel/Сохранение групп как jpg - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение групп как jpg (Макросы/Sub)
Сохранение групп как jpg
dmitrijaltman8 Дата: Четверг, 23.12.2021, 02:33 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 0 ±
Замечаний: 20% ±

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

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

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

Автор - dmitrijaltman8
Дата добавления - 23.12.2021 в 02:33
bmv98rus Дата: Пятница, 24.12.2021, 09:38 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3944
Репутация: 724 ±
Замечаний: 0% ±

Excel 2013/2016
dmitrijaltman8, тут обитают практически те же что и там


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
Сообщениеdmitrijaltman8, тут обитают практически те же что и там

Автор - bmv98rus
Дата добавления - 24.12.2021 в 09:38
dmitrijaltman8 Дата: Суббота, 25.12.2021, 02:55 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 0 ±
Замечаний: 20% ±

2016
Помогите решить задачу
 
Ответить
СообщениеПомогите решить задачу

Автор - dmitrijaltman8
Дата добавления - 25.12.2021 в 02:55
Pelena Дата: Суббота, 25.12.2021, 11:07 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 18555
Репутация: 4202 ±
Замечаний: ±

Excel 2016 & Mac Excel
Цитата dmitrijaltman8, 23.12.2021 в 02:33, в сообщении № 1 ()
почему-то не сохраняет группы фигур как картинки (а вытаскивает из них картинки и сохраняет как jpg именно их)

потому что в прошлой теме писали
Цитата dmitrijaltman8, 16.12.2021 в 17:26, в сообщении № 1 ()
если группировка .type=msoGroup, то рекурсивно углубляться до единичной

в макросе от New надо убрать строчки, углубляющиеся в группу
[vba]
Код
Sub SaveShapes()
    Dim iSht As Worksheet, iShape As Shape, EachShape As Shape
    Dim sFolderPath As String, oFSO As Object, sName As String
     
    Application.ScreenUpdating = False
    sFolderPath = ThisWorkbook.Path & "\"
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    For Each iSht In Worksheets 'каждый лист
        For Each iShape In iSht.Shapes 'каждый объект
'            If iShape.Type = msoGroup Then 'Если группа
'                For Each EachShape In iShape.GroupItems
                    If Not iShape.Name Like "*Oval*" And Not iShape.Name Like "*Rectangle*" And Not iShape.Name Like "*Line*" And Not iShape.Name Like "*Connector*" Then
                        If Not oFSO.folderexists(sFolderPath & iSht.Name) Then oFSO.CreateFolder (sFolderPath & iSht.Name)
                        sName = sFolderPath & iSht.Name & "\" & iShape.Name
                        iShape.Copy
                        With ActiveSheet.ChartObjects.Add(0, 0, iShape.Width, iShape.Height).Chart
                            .Parent.Select
                            .Paste
                            .Export Filename:=sName & ".jpg", FilterName:="jpg"
                            .Parent.Delete
                        End With
                    End If
'                Next EachShape
'            End If
        Next iShape
    Next iSht
    Application.ScreenUpdating = True
    MsgBox "Картинки сохранены!", vbInformation, "Конец"
End Sub
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Цитата dmitrijaltman8, 23.12.2021 в 02:33, в сообщении № 1 ()
почему-то не сохраняет группы фигур как картинки (а вытаскивает из них картинки и сохраняет как jpg именно их)

потому что в прошлой теме писали
Цитата dmitrijaltman8, 16.12.2021 в 17:26, в сообщении № 1 ()
если группировка .type=msoGroup, то рекурсивно углубляться до единичной

в макросе от New надо убрать строчки, углубляющиеся в группу
[vba]
Код
Sub SaveShapes()
    Dim iSht As Worksheet, iShape As Shape, EachShape As Shape
    Dim sFolderPath As String, oFSO As Object, sName As String
     
    Application.ScreenUpdating = False
    sFolderPath = ThisWorkbook.Path & "\"
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    For Each iSht In Worksheets 'каждый лист
        For Each iShape In iSht.Shapes 'каждый объект
'            If iShape.Type = msoGroup Then 'Если группа
'                For Each EachShape In iShape.GroupItems
                    If Not iShape.Name Like "*Oval*" And Not iShape.Name Like "*Rectangle*" And Not iShape.Name Like "*Line*" And Not iShape.Name Like "*Connector*" Then
                        If Not oFSO.folderexists(sFolderPath & iSht.Name) Then oFSO.CreateFolder (sFolderPath & iSht.Name)
                        sName = sFolderPath & iSht.Name & "\" & iShape.Name
                        iShape.Copy
                        With ActiveSheet.ChartObjects.Add(0, 0, iShape.Width, iShape.Height).Chart
                            .Parent.Select
                            .Paste
                            .Export Filename:=sName & ".jpg", FilterName:="jpg"
                            .Parent.Delete
                        End With
                    End If
'                Next EachShape
'            End If
        Next iShape
    Next iSht
    Application.ScreenUpdating = True
    MsgBox "Картинки сохранены!", vbInformation, "Конец"
End Sub
[/vba]

Автор - Pelena
Дата добавления - 25.12.2021 в 11:07
dmitrijaltman8 Дата: Суббота, 25.12.2021, 11:38 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 61
Репутация: 0 ±
Замечаний: 20% ±

2016
Pelena, спасибо вам.
теперь все стало ясно.
 
Ответить
СообщениеPelena, спасибо вам.
теперь все стало ясно.

Автор - dmitrijaltman8
Дата добавления - 25.12.2021 в 11:38
bmv98rus Дата: Суббота, 25.12.2021, 14:08 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3944
Репутация: 724 ±
Замечаний: 0% ±

Excel 2013/2016
ну и как обычно был еще кросс


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
Сообщениену и как обычно был еще кросс

Автор - bmv98rus
Дата добавления - 25.12.2021 в 14:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение групп как jpg (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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