Excel экспорт картинки в картинку

Хитрости »

1 Май 2011              182159 просмотров

Получили по почте файл-прайс с изображениями товара и эти картинки нужны в отдельной папки, а не на листе? Например для загрузки на сайт. Или для других целей. Подобной команды в Excel нет. Вставить картинки можно, а вот обратно к сожалению никак. Хорошо, если картинок штук 10, а если 100? А если таких книг много? И из всех надо сохранить картинки? Решил поделиться кодами, которые могут сохранять картинки из листа Excel в папку.
Если не знаете как применять коды Visual Basic for Applications, то настоятельно рекомендую к прочтению эти статьи:
Что такое макрос и где его искать?
Что такое модуль? Какие бывают модули?
Если хотите использовать один из нижеприведенных кодов, то следует создать стандартный модуль, скопировать нужные код и вставить его в этот модуль.

• Сохранение выделенной картинки в файл
• Сохранение всех картинок из всех выбранных файлов Excel в папку
• Сохранить выделенный диапазон в картинку
• Сохраняем все картинки с листа в папку с записью в ячейки имен картинок
• Сохранить картинки с листа с именами картинок из ячеек

Sub Save_Sel_Object_As_Picture()
    Dim sName As String, oObj As Object, wsTmpSh As Worksheet
    If VarType(Selection) <> vbObject Then
        MsgBox "Выделенная область не является объектом!", vbCritical, "www.excel-vba.ru"
    Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set oObj = Selection: oObj.Copy
    Set wsTmpSh = ThisWorkbook.Sheets.Add
    sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_" & oObj.Name
    With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart
        .ChartArea.Border.LineStyle = 0
        .Parent.Select
        .Paste
        .Export Filename:=sName & ".gif", FilterName:="GIF"
        .Parent.Delete
    End With
    wsTmpSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Если необходимо сохранить не только картинки, но и другие объекты, то необходимо в коде в строке: If oObj.Type = 13 Then изменить цифру. В коде комментариями указано, какая цифра какой тип обозначает. Так же можно изменить и расширение итогового файла с «.gif» на «.jpg». Достаточно найти расширение gif в коде(в двух местах) и заменить их на jpg. Если ни один объект не выделен, то ничего не произойдет.

Сохранение всех картинок из всех выбранных файлов Excel в папку

Sub Save_Object_As_Picture()
    Dim avFiles, li As Long, oObj As Object, wsSh As Worksheet, wsTmpSh As Worksheet
    Dim sImagesPath As String, sBookName As String, sName As String
    Dim wbAct As Workbook
    Dim IsForEachWbFolder As Boolean
 
    avFiles = Application.GetOpenFilename("Excel Files(*.xls*),*.xls*", , "Выбрать файлы", , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
 
    IsForEachWbFolder = (MsgBox("Сохранять картинки каждой книги в отдельную папку?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes)
 
    If Not IsForEachWbFolder Then
        sImagesPath = Environ("userprofile") & "desktopimages" '"
        If Dir(sImagesPath, 16) = "" Then
            MkDir sImagesPath
        End If
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wsTmpSh = ThisWorkbook.Sheets.Add
    For li = LBound(avFiles) To UBound(avFiles)
        Set wbAct = Workbooks.Open(avFiles(li), False)
        'создаем папку для сохранения картинок
        If IsForEachWbFolder Then
            sImagesPath = wbAct.Path & "" & wbAct.Name & "_images"
            If Dir(sImagesPath, 16) = "" Then
                MkDir sImagesPath
            End If
        End If
        sBookName = wbAct.Name
        For Each wsSh In Sheets
            For Each oObj In wsSh.Shapes
                If oObj.Type = 13 Then
                    '13 - картинки
                    '1 - автофигуры
                    '3 - диаграммы
                    oObj.Copy
                    sName = ActiveWorkbook.Name & "_" & wsSh.Name & "_" & oObj.Name
                    With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart
                        .ChartArea.Border.LineStyle = 0
                        .Parent.Select
                        .Paste
                        .Export Filename:=sImagesPath & sName & ".jpg", FilterName:="JPG"
                        .Parent.Delete
                    End With
                End If
            Next oObj
        Next wsSh
        wbAct.Close 0
    Next li
    Set oObj = Nothing: Set wsSh = Nothing
    wsTmpSh.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Объекты сохранены", vbInformation, "www.excel-vba.ru"
End Sub

Код позволяет выбрать одну или несколько книг Excel и сохраняет все картинки со всех листов выбранных книг. При запуске кода предлагается выбрать файлы Excel, картинки из которых надо сохранить. После этого появится запрос: «Сохранять картинки каждой книги в отдельную папку?»

• Да — для каждой книги будет создана своя папка images, в которую будут сохранены картинки с именами вида: ИмяКниги_ИмяЛиста_ИмяФигуры
• Нет — на рабочем столе пользователя будет создана папка images, в которую будут сохранены картинки с именами вида: ИмяКниги_ИмяЛиста_ИмяФигуры

Если необходимо сохранить не только картинки, но и другие объекты, то необходимо в коде в строке: If oObj.Type = 13 Then изменить цифру. В коде комментариями указано, какая цифра какой тип обозначает. Так же можно изменить и расширение итогового файла с «.jpg» на «.gif». Достаточно найти расширение jpg в коде(в двух местах) и заменить их на gif. В данном коде я намеренно сделал сохранение в формат jpg, чтобы можно было сравнить с предыдущим кодом и увидеть как правильно менять расширение(формат) файла.

Сохранить выделенный диапазон в картинку

Данные код сохраняет выделенный на листе диапазон в картинку.

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

Просто выделяем диапазон, который необходимо сохранить как картинку и запускаем код. Картинка будет сохранена в папку с активной книгой.

СОХРАНЯЕМ ВСЕ КАРТИНКИ С ЛИСТА В ПАПКУ С ЗАПИСЬЮ В ЯЧЕЙКИ ИМЕН КАРТИНОК

Код ниже сохраняет все картинки на активном листе в папку

images

, которая создается в папке с книгой Excel, картинки из которой сохраняются. Если папки

images

нет — она будет создана. Картинкам даются имена

«img1», «img2», «img3»

и т.д. Картинки из ячеек удаляются, а на их место записывается имя картинки. Актуально, наверное, для тех, кто из таких файлов делает потом выгрузки в интернет-магазины и пр.

Sub Save_Object_As_Picture()
    Dim li As Long, oObj As Shape, wsSh As Worksheet, wsTmpSh As Worksheet
    Dim sImagesPath As String, sName As String
 
    sImagesPath = ActiveWorkbook.Path & "images" '"
    If Dir(sImagesPath, 16) = "" Then
        MkDir sImagesPath
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wsSh = ActiveSheet
    Set wsTmpSh = ActiveWorkbook.Sheets.Add
    For Each oObj In wsSh.Shapes
        If oObj.Type = 13 Then
            li = li + 1
            oObj.Copy
            sName = "img" & li
            With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart
                .ChartArea.Border.LineStyle = 0
                .Parent.Select
                .Paste
                .Export Filename:=sImagesPath & sName & ".jpg", FilterName:="JPG"
                .Parent.Delete
            End With
            oObj.TopLeftCell.Value = sName
            oObj.Delete 'удаляем картинку с листа
        End If
    Next oObj
    Set oObj = Nothing: Set wsSh = Nothing
    wsTmpSh.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Объекты сохранены в папке: " & sImagesPath, vbInformation, "www.excel-vba.ru"
End Sub

В коде все так же, как в кодах выше(можно сохранять другие объекты, можно изменить формат сохраняемых картинок). Только при этом в ячейку, в которой была картинка записывается имя, с которым эта картинка была сохранена в папку на компьютере. Сама картинка при этом удаляется. Если удалять не надо, то необходимо просто удалить строку:
oObj.Delete ‘удаляем картинку с листа
Если необходимо записать в ячейку не только имя картинки, но и полный путь(включая путь к папке и расширение картинки), то надо вместо строки:
oObj.TopLeftCell.Value = sName
записать такую:
oObj.TopLeftCell.Value = sImagesPath & sName & «.jpg»

Сохранить картинки с листа с именами картинок из ячеек

Пожалуй, самый популярный код. Он сохраняет картинки из активного листа с именами, взятыми из ячеек, в которых эти картинки расположены. При этом можно указать, чтобы имена брались из той же строки, но другого столбца:

Sub Save_Object_As_Picture_NamesFromCells()
    Dim li As Long, oObj As Shape, wsSh As Worksheet, wsTmpSh As Worksheet
    Dim sImagesPath As String, sName As String
    Dim lNamesCol As Long, s As String
 
    s = InputBox("Укажите номер столбца с именами для картинок" & vbNewLine & _
                 "(0 - столбец в котором сама картинка)", "www.excel-vba.ru", "")
    If StrPtr(s) = 0 Then Exit Sub
    lNamesCol = Val(s)
 
    sImagesPath = ActiveWorkbook.Path & "images" '"
    If Dir(sImagesPath, 16) = "" Then
        MkDir sImagesPath
    End If
'    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wsSh = ActiveSheet
    Set wsTmpSh = ActiveWorkbook.Sheets.Add
    For Each oObj In wsSh.Shapes
        If oObj.Type = 13 Then
            oObj.Copy
            If lNamesCol = 0 Then
                sName = oObj.TopLeftCell.Value
            Else
                sName = wsSh.Cells(oObj.TopLeftCell.Row, lNamesCol).Value
            End If
            'если в ячейке были символы, запрещенные
            'для использования в качестве имен для файлов - удаляем
            sName = CheckName(sName)
            'если sName в результате пусто - даем имя unnamed_ с порядковым номером
            If sName = "" Then
                li = li + 1
                sName = "unnamed_" & li
            End If
            With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart
                .ChartArea.Border.LineStyle = 0
                .Parent.Select
                .Paste
                .Export Filename:=sImagesPath & sName & ".jpg", FilterName:="JPG"
                .Parent.Delete
            End With
        End If
    Next oObj
    Set oObj = Nothing: Set wsSh = Nothing
    wsTmpSh.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Объекты сохранены в папке: " & sImagesPath, vbInformation, "www.excel-vba.ru"
End Sub
'---------------------------------------------------------------------------------------
' Procedure : CheckName
' Purpose   : Функция проверки правильности имени
'---------------------------------------------------------------------------------------
Function CheckName(sName As String)
    Dim objRegExp As Object
    Dim s As String
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True: objRegExp.IgnoreCase = True
    objRegExp.Pattern = "[:,\,/,?,*,<,>,',|,""""]"
    s = objRegExp.Replace(sName, "")
    CheckName = s
End Function

Укажите номер столбца с именами для картинок — указывается порядковый номер столбца на листе, из которого брать имя для сохраняемой картинки. Например, сами картинки в столбце H, а имена для них записаны в столбце B. Надо указать 2. Тогда для картинки в ячейке H3 будет использовано имя, записанное в ячейке В3. Расширение для картинки указывать не надо(например — image1, image2, image_product_sell1 и т.п.).
Если номер не указывать или указать 0 — то имя для картинок будет взято из тех ячеек, в которых находятся эти картинки.
Так же проверяется корректность значений в ячейках, т.к. они могут содержать символы, недопустимые в именах файлов(слеши и пр.). В этом случаи эти символы будут удалены. И если после удаления этих символов значение будет пустым — имена картинкам будут даваться с префиксом «unnamed_» и порядковым номером таких картинок.

Скачать пример

  Tips_Macro_Save_Object_As_Picture.xls (76,0 KiB, 15 154 скачиваний)

Также см.:
Сохранить диаграммы в графический файл
Сохранение выделенного диапазона в графический файл
Как скопировать картинку из примечания?

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Помогла ли Вам статья?

Надстройка позволяет экспортировать все изображения с листа Excel в графические файлы.

Доступен выбор типа создаваемых файлов (поддерживаются форматы JPG, GIF и PNG)

Кроме того, можно указать имя папки, в которую будут помещены созданные файлы
(эта папка будет создана автоматически в том же каталоге, где расположен обрабатываемая книга Excel)

Если нужно сохранять картинки под именами из заданного столбца, либо производить другие действия с картинками (вставку на лист, вставку по ссылкам, поиск картинок в интернете), то воспользуйтесь универсальной надстройкой PastePictures.
Функция выгрузки изображений в файлы там присутствует в меню Изображения — Сохранить картинки с листа

В имени папки можно указать кодовое слово $filename — оно будет заменено на название текущего (обрабатываемого) файла Excel.

Для запуска экспорта картинок в файлы нажмите комбинацию клавиш Ctrl + Shift + P

На форме выберите формат сохраняемых изображений, и название папки для экспорта:

По завершении сохранения изображений макрос выдаст уведомление:

Результат экспорта изображений в созданной папке:

Очень часто в рабочем документе пользователь может столкнуться с необходимостью вставить картинку или же, наоборот, сохранить её на свой компьютер. Например, вам поступил прайс или каталог, и иллюстрации, содержащиеся в нём, необходимы вам для наполнения интернет-магазина. Может показаться, что всё довольно легко, однако, многие сталкиваются с проблемами в попытках вытащить их из документа в формате Excel. Давайте выясним, какие действия следует предпринять, чтобы быстро и без проблем вставить или вытащить изображение из Excel.

Вставка фото или рисунка

Чтобы поместить рисунок на листе, перейдите во вкладку «Вставка», там вы найдёте область «Иллюстрации». Выделите ячейку, в которую вы хотите его вставить, нажмите на кнопку «Рисунок» или «Картинка» и в появившемся меню выберите необходимое изображение. По умолчанию открывается папка «Изображения», в которую, как правило, сохраняются все файлы, загруженные из интернета. Если же необходимое изображение находится в другом месте, после перехода в меню «Рисунок», обратите внимание на окно, появившееся слева. Это корневая структура всех носителей и папок, находящихся на компьютере. Благодаря ей вы можете найти именно ту папку, в которую вы сохранили рисунок.

Открытое изображение можно подвергнуть всяческим изменениям, например, увеличению, уменьшению или развороту. Кликнув на рисунок, и таким образом, выделив его, вы заметите, что он будет заключён в рамку с кружками и квадратами. Перетаскивая их, вы будете увеличивать или уменьшать размер картинки, а зелёный кружочек сверху позволит развернуть его как вам угодно. Также рисунок можно подвергнуть более серьёзным настройкам, выделив и кликнув правой кнопкой мыши, а в появившемся контекстном меню выбрать пункт «Размер и положение». В появившемся окне предоставлена информация об исходном размере изображения, есть возможность задать точные параметры высоты, ширины и поворота. Если желательно сохранить пропорции изображения, поставьте галочку напротив пунктов «Сохранить пропорции» и «Относительно исходного размера». Эти настройки предназначены в основном для изменения размера и формы, однако, вы также можете изменить сам рисунок, придав ему, например, конкретный оттенок или, вообще, перекрасить. Выделив его, в самом низу вы увидите пункт «Формат рисунка». Здесь вам доступны функции наделения изображения тенью, настройка её цвета и угла падения. Кроме того, вы можете настроить его отражение, настроив сторону, куда он будет отражаться, размер, прозрачность, расстояние и т. д. На самом деле, там множество разнообразных параметров, регулировка которых в конечном счёте сможет изменить изображение до неузнаваемости.

  Сохранение картинки, фото и т. д.

Итак, мы разобрались, как можно копировать рисунок и вставить его в документ, а кроме этого, выяснили, где и каким именно изменениям можно его подвергнуть. Однако иногда встаёт вопрос, как же «вытянуть» или сохранить изображения, которые размещены в скачанном с интернета документе формата Excel? Существует несколько вариантов.

1. Сохраните документ в формате интернет-страницы, то есть html. Выберите пункт «Меню», а там «Сохранить как». В выпадающем списке пункта «Типа файла» выберите веб-страница. Там их несколько и вы можете выбрать любую. Перейдите в ту директорию, где был сохранен ваш документ и откройте его с помощью браузера. В нём вы увидите сам текст и все изображения, которые будет легко скачать просто кликнув на них правой кнопкой мыши и выбрав команду «Сохранить картинку как». Название самой команды может варьироваться, в зависимости от установленного браузера.
2. Если изображение изначально имеет хорошее разрешение и качество, вы можете растянуть его, скопировать, используя комбинацию клавиш «Ctrl+C», а затем открыть стандартную программу Paint и вставить. Затем сохраняем и получаем файл в формате PNG.
3. Кроме вышеуказанных простых операций, популярность программы Excel обеспечила её дополнительным софтом, который предназначен для решения разнообразных специфических и конкретных задач. Именно с этой целью была создана надстройка именуемая PastePictures. Благодаря ей, программа производит поиск картинок в указанной папке, основываясь на содержимом ячеек таблицы, а затем вставляет их в соседние ячейки или примечания к ним. Помимо этого, её функциональность позволяет скачивать изображения по ссылкам и сохранять их в конкретные папки, а затем вставлять в примечания к ячейкам. Скачав надстройку и открыв её, вам будет предоставлена возможность тестового прогона, во время которого вы увидите её основные возможности на примере специально созданного документа, куда затем будут добавлены картинки и изменён формат таблицы. Кроме этого, в ней есть множество других параметров, которые позволят вам с удобством работать над таблицами, вставлять и сохранять изображения. Выше был описан процесс вставки картинок в документ. Чтобы сохранить их, выберите установленную надстройку и в левом верхнем углу кликните на команду «Изображения». В ней вы увидите пункт «Сохранить картинки с листа в файлы», благодаря которому вы и перенесёте изображения в память вашего компьютера. Скачать надстройку можно, перейдя по этой ссылке — http://excelvba.ru/programmes/PastePictures.

Вышеуказанные действия помогут вам в решении проблемы сохранения и вставки разнообразных изображений в документах формата Excel, а некоторые из них применимы и в Word.