Здравствуйте. Помогите сделать макрос. Как диапазоны, записанные в столбец S5:S - сохранить как jpg с именами записанными в столбце T5:T (в каталог, записанный в ячейку T3) ?
Здравствуйте. Помогите сделать макрос. Как диапазоны, записанные в столбец S5:S - сохранить как jpg с именами записанными в столбце T5:T (в каталог, записанный в ячейку T3) ?Dalm
Sub u_72() Application.ScreenUpdating = False Application.DisplayAlerts = False q = Range("t3").Value r = "s5:s15" For Each c In Range(r) s = c.Value If s <> "" Then Range(s).Copy Set u = ThisWorkbook.Sheets.Add With ActiveSheet.Pictures.Paste a = .Width b = .Height .Copy End With With u.ChartObjects.Add(0, 0, a, b).Chart .Paste .Export Filename:=q & c.Offset(, 1) & ".jpg", FilterName:="jpg" End With u.Delete End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
[/vba]
[vba]
Код
Sub u_72() Application.ScreenUpdating = False Application.DisplayAlerts = False q = Range("t3").Value r = "s5:s15" For Each c In Range(r) s = c.Value If s <> "" Then Range(s).Copy Set u = ThisWorkbook.Sheets.Add With ActiveSheet.Pictures.Paste a = .Width b = .Height .Copy End With With u.ChartObjects.Add(0, 0, a, b).Chart .Paste .Export Filename:=q & c.Offset(, 1) & ".jpg", FilterName:="jpg" End With u.Delete End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
Nic70y, спасибо. Но не работает. Сохраняет просто пустые белые растры. Эти растры примерно того же размера, что и заданные диапазоны. Но в них - ничего нет. Я имел ввиду - сохранение растров по диапазонам - с их содержимым.
Nic70y, спасибо. Но не работает. Сохраняет просто пустые белые растры. Эти растры примерно того же размера, что и заданные диапазоны. Но в них - ничего нет. Я имел ввиду - сохранение растров по диапазонам - с их содержимым.Dalm
А у меня тоже пустые картинки получаются. Причем, если сделать паузу между ChartObjects.Add и Paste, то всё норм, а если не делать то картинка отдельно, диаграмма - отдельно Видимо, от офиса зависит. Задержка по времени не решает проблему, так что решения пока не нашла
Добавлено =========== В общем, вот так у меня корректно сохраняется [vba]
Код
Sub u_72() Application.ScreenUpdating = False Application.DisplayAlerts = False q = Range("t3").Value r = "s5:s15" For Each c In Range(r) s = c.Value If s <> "" Then Range(s).Copy Set u = ThisWorkbook.Sheets.Add With ActiveSheet.Pictures.Paste a = .Width b = .Height .Copy End With With u.ChartObjects.Add(0, 0, a, b) .Activate .Chart.Paste .Chart.Export Filename:=q & c.Offset(, 1) & ".jpg", FilterName:="jpg" End With u.Delete End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
[/vba]
А у меня тоже пустые картинки получаются. Причем, если сделать паузу между ChartObjects.Add и Paste, то всё норм, а если не делать то картинка отдельно, диаграмма - отдельно Видимо, от офиса зависит. Задержка по времени не решает проблему, так что решения пока не нашла
Добавлено =========== В общем, вот так у меня корректно сохраняется [vba]
Код
Sub u_72() Application.ScreenUpdating = False Application.DisplayAlerts = False q = Range("t3").Value r = "s5:s15" For Each c In Range(r) s = c.Value If s <> "" Then Range(s).Copy Set u = ThisWorkbook.Sheets.Add With ActiveSheet.Pictures.Paste a = .Width b = .Height .Copy End With With u.ChartObjects.Add(0, 0, a, b) .Activate .Chart.Paste .Chart.Export Filename:=q & c.Offset(, 1) & ".jpg", FilterName:="jpg" End With u.Delete End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
