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

Вход

Регистрация

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

 

= Мир MS Excel/Определение ширины и высоты сохраняемого jpg файла. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение ширины и высоты сохраняемого jpg файла. (Макросы/Sub)
Определение ширины и высоты сохраняемого jpg файла.
perven Дата: Пятница, 24.11.2017, 16:04 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день, специалисты по экселю.
помогите с решением технического вопроса.

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

Как в момент выполнения макроса - вписать в соседнюю таблицу B8:D15 - название сохраняемого рисунка, а также его высоту и ширину (с учетом масштаба из ячейки E2) ?
К сообщению приложен файл: 23525.xlsb(25Kb)
 
Ответить
СообщениеДобрый день, специалисты по экселю.
помогите с решением технического вопроса.

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

Как в момент выполнения макроса - вписать в соседнюю таблицу B8:D15 - название сохраняемого рисунка, а также его высоту и ширину (с учетом масштаба из ячейки E2) ?

Автор - perven
Дата добавления - 24.11.2017 в 16:04
Roman777 Дата: Воскресенье, 26.11.2017, 11:58 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 806
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
perven, Примерно так:
[vba]
Код
Sub nnn()
    Dim pic As Shape
    Dim nm$
    Dim m As Double
    Dim a As Chart
    Dim k As Long
    k = 8
    If Cells(2, 5) <> "" Then
        m = Cells(2, 5)
    Else
        m = 1
    End If
'-----------------------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveSheet
        For Each pic In .Shapes
            If pic.Type = 3 Or pic.Type = 6 Then
                k = k + 1
                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
                    '''''''''''
                    .ChartArea.Height = .PlotArea.Height * m
                    .ChartArea.Width = .PlotArea.Width * m
                    
                    Cells(k, 2) = pic.Name
                    Cells(k, 3) = .ChartArea.Width
                    Cells(k, 4) = .ChartArea.Height
                    '''''''''''
                    .Export Filename:=nm, FilterName:="JPG"
                    .Parent.Delete
                End With
            End If
        Next
    End With
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Beep
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
Сообщениеperven, Примерно так:
[vba]
Код
Sub nnn()
    Dim pic As Shape
    Dim nm$
    Dim m As Double
    Dim a As Chart
    Dim k As Long
    k = 8
    If Cells(2, 5) <> "" Then
        m = Cells(2, 5)
    Else
        m = 1
    End If
'-----------------------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveSheet
        For Each pic In .Shapes
            If pic.Type = 3 Or pic.Type = 6 Then
                k = k + 1
                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
                    '''''''''''
                    .ChartArea.Height = .PlotArea.Height * m
                    .ChartArea.Width = .PlotArea.Width * m
                    
                    Cells(k, 2) = pic.Name
                    Cells(k, 3) = .ChartArea.Width
                    Cells(k, 4) = .ChartArea.Height
                    '''''''''''
                    .Export Filename:=nm, FilterName:="JPG"
                    .Parent.Delete
                End With
            End If
        Next
    End With
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Beep
End Sub
[/vba]

Автор - Roman777
Дата добавления - 26.11.2017 в 11:58
perven Дата: Воскресенье, 26.11.2017, 12:06 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Roman777, работает.
Спасибо за макрос.
 
Ответить
СообщениеRoman777, работает.
Спасибо за макрос.

Автор - perven
Дата добавления - 26.11.2017 в 12:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение ширины и высоты сохраняемого jpg файла. (Макросы/Sub)
Страница 1 из 11
Поиск:

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