Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для сохранения выделенной области в JPG c присвоением имени из ячейки
 
#1
28.06.2017 14:11:35
Если есть возможность реализовать, то интересует такой хитрый Макрос для сохранения выделенной области в png или jpg в папку с названием "отчеты", а название файла брал из указанной ему ячейки.
P/s максимум что мне удалось сделать это копировать выделенную область в буфер обмена, а дальше через paint и.т.д .
Хотелось бы автоматизировать процесс
Код
Sub Макрос8()
'
' Макрос8 Макрос
'

'
    Range("A2:D20").Select
    Range("D20").Activate
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub
Изменено: Felixandr - 28.06.2017 14:18:08
 
 
 
#2
28.06.2017 14:17:34
Обсуждалось тут
http://www.cyberforum.ru/vba/thread167455.html
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
28.06.2017 14:21:30
Решение есть здесь.
 
 
 
#4
28.06.2017 14:43:05
Данный макрос сохраняет выделенный диапазон в картинку.
Но картинка сохраняется там же, где и документ, а нужно там же , но в своей собственной папке "Отчеты".
И еще нужно, чтобы название картинки бралось из ячейки документа
Код
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
            .Parent.Select
            .Paste
            .Export Filename:=sName & ".gif", FilterName:="GIF"
            .Parent.Delete
        End With
    End With
    wsTmpSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Изменено: Felixandr - 28.06.2017 15:47:54
 
 
 
#5
28.06.2017 15:02:06
Вместо ActiveWorkbook.FullName укажите свой путь + имя файла. Как брать имя из ячейки - также есть в указанной статье.
 
 
 
#6
28.06.2017 15:18:55
Проблема в том что папка должна создаваться в папке с файлом ,так как для разных компьютеров этот путь будет разным.
 
 
 
#7
28.06.2017 15:21:12
Цитата
Felixandr написал:
папка должна создаваться в папке с файлом
Причём тут ПАПКА?
 
 
 
#8
28.06.2017 15:22:20
Цитата
Юрий М написал:
Причём тут ПАПКА?
Цитата
Felixandr написал:
а нужно, что бы в папке где и файл создалась своя папка "ОТЧЕТЫ"
 
 
 
#9
28.06.2017 15:31:09
Изначально про СОЗДАНИЕ папки в теме ни слова. Создание папки - совсем другая тема. Ищите темы про создание папки. После того, как папка будет создана, нужно будет изменить строку так:
Код
sName = ThisWorkbook.Path & "\Отчеты\" & Sheets("Лист1").Range("A1")
 
 
 
#10
29.06.2017 00:02:14
СПАСИБО за строчку. Автоматическое создание папки так и не осилил. Да и бог с ним. Работает кое как и на этом хорошо.
P/S Возник вопрос по серьёзнее, что-бы весь документ сохранялся в pdf, но тут уж точно нужно быть гуру, чтоб такое замутить!
Изменено: Felixandr - 29.06.2017 00:03:50
 
 
 
Страницы: 1
Читают тему
Наверх