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

Вход

Регистрация

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

 

= Мир MS Excel/Сохранение заданного диапазона - как картинки. - Мир MS Excel

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

Excel 2010
Здравствуйте, помогите решить проблему.

На листе - много текста и много фигур.
В ячейку С4 - вписана ячейка начала диапазона.
В ячейку D4 - вписана ячейка конца диапазона.

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

На листе - много текста и много фигур.
В ячейку С4 - вписана ячейка начала диапазона.
В ячейку D4 - вписана ячейка конца диапазона.

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

Автор - RipVanWinkel
Дата добавления - 21.11.2017 в 18:03
alex77755 Дата: Вторник, 21.11.2017, 18:29 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 333
Репутация: 60 ±
Замечаний: 0% ±

выделенный диапазон так:
[vba]
Код
Sub Range_to_Picture()
    Dim sName As String, wsTmpSh As Worksheet
    If TypeName(Selection) <> "Range" Then
        MsgBox "Выделенная область не является диапазоном!", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Selection
        .CopyPicture
        Set wsTmpSh = ThisWorkbook.Sheets.Add
        sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_Range"
        With wsTmpSh.ChartObjects.Add(0, 0, .Width, .Height).Chart
            .ChartArea.Border.LineStyle = 0
            .Paste
            .Export Filename:=sName & ".png", FilterName:="PNG"
            .Parent.Delete
        End With
    End With
    wsTmpSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
[/vba]
Добавь выделение сам
Имя изменить тоже для самостоятельной работы


Могу помочь в VB6, VBA
Alex77755@mail.ru


Сообщение отредактировал alex77755 - Вторник, 21.11.2017, 18:32
 
Ответить
Сообщениевыделенный диапазон так:
[vba]
Код
Sub Range_to_Picture()
    Dim sName As String, wsTmpSh As Worksheet
    If TypeName(Selection) <> "Range" Then
        MsgBox "Выделенная область не является диапазоном!", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Selection
        .CopyPicture
        Set wsTmpSh = ThisWorkbook.Sheets.Add
        sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_Range"
        With wsTmpSh.ChartObjects.Add(0, 0, .Width, .Height).Chart
            .ChartArea.Border.LineStyle = 0
            .Paste
            .Export Filename:=sName & ".png", FilterName:="PNG"
            .Parent.Delete
        End With
    End With
    wsTmpSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
[/vba]
Добавь выделение сам
Имя изменить тоже для самостоятельной работы

Автор - alex77755
Дата добавления - 21.11.2017 в 18:29
RipVanWinkel Дата: Среда, 22.11.2017, 06:35 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
alex77755, ясно попробую разобраться.
Спасибо за наводку.
 
Ответить
Сообщениеalex77755, ясно попробую разобраться.
Спасибо за наводку.

Автор - RipVanWinkel
Дата добавления - 22.11.2017 в 06:35
krosav4ig Дата: Среда, 22.11.2017, 15:07 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1485
Репутация: 611 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще вариант
Модуль modPastePicture, взят тут (файл PastePicture.zip)
в модуле Лист3 [vba]
Код
Private Sub range2bmp()
    Dim InitialFileName$, FileFilter$, FilePath$
    Me.Range([C4] & ":" & [D4]).CopyPicture xlScreen, xlBitmap
    InitialFileName = ActiveWorkbook.Path & "\*.bmp"
    FileFilter = "Растровое изображение (*.bmp), *.bmp"
    FilePath = Application.GetSaveAsFilename(InitialFileName, FileFilter)
    If FilePath <> "False" Then SavePicture PastePicture(xlBitmap), FilePath Else Err.Raise 380
End Sub
[/vba]
К сообщению приложен файл: 1055408.zip(54Kb)


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Четверг, 23.11.2017, 13:40
 
Ответить
Сообщениееще вариант
Модуль modPastePicture, взят тут (файл PastePicture.zip)
в модуле Лист3 [vba]
Код
Private Sub range2bmp()
    Dim InitialFileName$, FileFilter$, FilePath$
    Me.Range([C4] & ":" & [D4]).CopyPicture xlScreen, xlBitmap
    InitialFileName = ActiveWorkbook.Path & "\*.bmp"
    FileFilter = "Растровое изображение (*.bmp), *.bmp"
    FilePath = Application.GetSaveAsFilename(InitialFileName, FileFilter)
    If FilePath <> "False" Then SavePicture PastePicture(xlBitmap), FilePath Else Err.Raise 380
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 22.11.2017 в 15:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение заданного диапазона - как картинки. (Макросы/Sub)
Страница 1 из 11
Поиск:

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