Макрос для сохранения всех картинок из Word в файл

[Nitro]

Доброго времени суток всем форумчанам!!!!!!!!!!!!!
Видел подобную тему, но там толком не понял.
Подскажите пожалуйста кто знает VB как сохранить все картинки из документа Word в файл. Уже весь инет перевернул, ничего нет. Все говорят о какой-то API функции, но никто о ней не знает видимо это тайна .
Вот мой код:

Sub changeImages2()
Dim pic As Object
Dim ClipPicture As IPictureDisp
Dim FileName As String

For Each pic In ActiveDocument.Content.InlineShapes

pic.Select

Selection.Cut

FileName = "C:\my" 'Имя файла без расширения

Set ClipPicture = Clipboard.GetData(vbCFBitmap)
SavePicture ClipPicture, FileName & ".bmp"

Next

End Sub


Говорят что VB вроде не работает с Clipboard, надо API функцией воспользоваться, о которой я уже говорил выше.

Вобщем помогите пожалуйста. Буду весьма благодарен.

[EducatedFool]

В этой теме же приведён пример выполнения Вашей задачи...

Там же приведены API-функции для работы с Clipboard:

Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Вам надо код для VB, или для VBA ?

[Nitro]

Спасибо, но теперь как это все будет выглядеть конкретно для моего примера? Можно поподробнее? Ещё раз спасибо!!!

[Nitro]

Все разобрался. Спасибо большое ещё раз!

[viter.alex]

Вот функция, которая сохраняет картинку из буфера в файл. Можно указать путь и имя файла, а если не указывать, то имя будет случайным, а сохранять в Temp. Я ее модифицировал по сравнению с той, что была раньше.

Public Function Clip2File(Optional Filename As String, Optional Path = "")
  
  Dim sFileName As String, sPath As String
  Dim strOutputPath As String, oPic As IPictureDisp
  'Путь к папке для сохранения файла
  'Если путь пустой, то копируем в «TEMP». Если нет, то в указанyю папку
  sPath = IIf(Path = "", Environ("TEMP"), Path)
  'Если имя файла не указано, то генерируем случайное имя
  If Filename = "" Then
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sFileName = FSO.GetTempName(): sFileName = Mid(sFileName, 1, InStrRev(sFileName, ".") - 1)
  Else: sFileName = Filename: End If
  'Get the filename to save the bitmap to
  strOutputPath = sPath & "\" & sFileName & ".bmp"
  
  'Retrieve the picture from the clipboard...
  Set oPic = GetClipPicture()
  
  '... and save it to the file
  If Not oPic Is Nothing Then
    SavePicture oPic, strOutputPath
    Clip2File = strOutputPath
  Else
    Clip2File = ""
    MsgBox "Unable to retrieve bitmap from clipboard"
  End If
End Function

А с буфером можно по-тихоньку работать и в VBA. Читай справку по объекту DataObject

[Lugovaya]

Помогите, пожалуйста. Программка наподобие этой. Нужно с листа Excel скопировать картинку и положить ее в папку с рабочим файлом.
1) Как определить картинку на листе?
2) Какой у нее должен быть тип чтобы срабатывала функция SavePicture