Вытащить картинку из ячейки, как?

[a69]

Доброго дня.

Таблица, ячейки пронумерованы, в определенных ячейках лежат картинки.
Надо вытащить эти картинки и записать их в файлы.
Чет не соображу как, подскажите плиз.

Спасибо заранее.

[SAS888]

"Вытащить" картинки с рабочего листа Excel и записать их в отдельные файлы можно через буфер обмена с помощью API-функций. Например, следующий код создаст в корневом каталоге диска "C:\" jpg-файлы, содержащие все имеющиеся на активном листе картинки:

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
   
Sub Main()
    Dim sh As Shape, n As Long
    For Each sh In ActiveSheet.Shapes
        If sh.Type = msoPicture Then
            sh.CopyPicture: OpenClipboard (0&): n = GetClipboardData(14)
            CopyEnhMetaFile n, "c:\" & "picture" & n & ".jpg": CloseClipboard
        End If
    Next
End Sub

Пример во вложении. Откройте файл и запустите макрос "Main".

[a69]

Ого! Быстро!
Ну спасибо!!!

Работает

Наберусь смелости на еще один вопросик, как присвоить имени картинки имя ячейки где она находится?

[SAS888]

как присвоить имени картинки имя ячейки где она находится?

Для этого, в коде из поста № 2 строку

CopyEnhMetaFile n, "c:\" & "picture" & n & ".jpg": CloseClipboard

замените на

CopyEnhMetaFile n, "c:\" & Replace(sh.TopLeftCell.Address, "$", "") & ".jpg": CloseClipboard

[a69]

Просто супер!
Приятно видеть работу профессионала, спасибо!

[Dimas999]

Сообщение от SAS888

Для этого, в коде из поста № 2 строку

CopyEnhMetaFile n, "c:\" & "picture" & n & ".jpg": CloseClipboard

замените на

CopyEnhMetaFile n, "c:\" & Replace(sh.TopLeftCell.Address, "$", "") & ".jpg": CloseClipboard

Скажите, а это правильный jpg-формат? Не надо как-то явно указывать формат вывода картинки из clipboard?
Picasa Viewer, например, его не понимает, хотя стандартный виндовый просмотрщик - кушает на уря...

[EducatedFool]

Picasa Viewer, например, его не понимает, хотя стандартный виндовый просмотрщик - кушает на уря...

Для Windows и большинства программ не важно расширение графического файла - оно определяется автоматически по содержимому.
Можете проверить - переименовать jpg в bmp или emf или png - файлы как открывались, так и будут открываться.

Скорее всего, код сохраняет рисунки в формат .emf
Для сохранения в настоящий JPG код надо усложнить.
Примеры кода есть в инете.
Вот один из них:
http://excelvba.ru/programmes/ExportCharts

[Казанский]

> Скажите, а это правильный jpg-формат?
Нет. IrfanView сообщает, что это WMF. Вы размер файлов видели? 489 и 902 кб!
Можно встроенными средствами, без API:

Sub ExportPics()
Dim sh As Shape, n As Long, ash As Worksheet
Set ash = ActiveSheet
With Charts.Add
    For Each sh In ash.Shapes
        If sh.Type = msoPicture Then
            .ChartArea.Width = sh.Width
            .ChartArea.Height = sh.Height
            sh.CopyPicture
            .Paste
            .Export "c:\picture" & n & ".jpg", "JPG"
            n = n + 1
        End If
    Next
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With
End Sub

[Анастатия]

Добрый день! Скажите пожалуйста, сама не могу сообразить : документ Exel - в нем в столике есть номер когда навожу на него курсор появляется картинка, убираю соответственно исчезает...скопировать или еще что то не получается, т.е. эта картинка я так понимаю прикреплена туда....вот ее мне нужно от туда достать, объясните как это сделать, мучаюсь 2 ч. Заранее большое спасибо.

[EducatedFool]

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