Т.е. запускаешь ее. и она сохраняет картинку в файл

"Картинку буфера обмена"

paint ctrl+v ctrl+s
наверное долго?

rundll + cClipboardObject.Dll

(3) это уже интересно, можно поподробнее?

(2) Программа! А не руки

кнопка PrintScreen, а затем ctrl+v в любой гр.редактор?

rundll позволяет запускать функции из dll а у cClipboardObject есть функция по сохранению картинки из буфера обмена в файл... но самой dll у меня нету, про функцию такую вчера здеся на мисте услышал....

или тебе что-то вроде CaptureEze Pro надо?

ну одноЭсники мудаки.... полные...


программа буфера обмена сама умеет все сохранять и восстанавливать и не только картинки...

hypersnap

fraps512

еще один придуроДятел....

ps прога есть в любых виндах....

clipboard viewer в составе винды

(12) умный? так нах расмисделся?

(12) ПРограммно, а не руками.
(11) какая программа?

(7) Блин, это уже интересно

(0) нетрудно догадаться по названию кто автор темы, а по содержимому - зачем сироже это нужно. Наверняка для автоматизации процесса сбора порнофоток. Сося, ну куда тебе столько порнухи то....

судя по постам пита и    Fragster ответ есть дето там:
http://search.microsoft.com/results.aspx?form=MSHOME&mkt=en-US&setlang=en-US&q=clipboard
Хотя и могли бы просвятить без распальцовки...

http://www.computerra.ru/gid/rtfm/system/301629/

Работа с буфером обмена Windows из командной строки
Автор: Андрей Крупин
Опубликовано 09 января 2007 года

Как научиться мастерски манипулировать содержимым буфера обмена Windows из консоли, не обращаясь к графическому интерфейсу операционной системы? Подобный вопрос нередко задают себе пользователи, занимающиеся написанием BAT- или CMD-скриптов с целью автоматизации часто выполняемых задач и желающих хоть как-то расширить возможности командного интерпретатора.

Предлагаемое нами решение задачи управления буфером обмена Windows из командной строки основано на использовании программных наработок Карла Питерсона, объединенных под общим названием ConClip. Чтобы воспользоваться ими, необходимо скачать со страницы разработчика архив conclip.zip размером в 45,6 килобайтов и извлечь из него две бесплатные утилиты GetClip и SetClip.1

Первая программа GetClip предназначена для извлечения хранимой в буфере обмена Windows текстовой информации средствами следующих основных ключей:
/text - вывод данных обычным текстом (используется по умолчанию)
/rtf - вывод данных в формате RTF
/html - вывод данных в формате HTML
/enum - отображение форматов объектов, присутствующих в буфере
/? - вызов справки

Вторая утилита SetClip выполняет противоположную задачу, то есть помещает указанный текст в буфер обмена операционной системы. В качестве передаваемых приложению параметров могут использоваться ключи:
/clear - очистка буфера
/text - копирование данных в буфер в формате обычного текста (применяется по умолчанию)
/rtf - пересылка данных в виде документа RTF
/html - копирование данных в буфер в гипертекстовом формате
/add - добавление новых данных к уже хранящимся в буфере обмена (используется для разноформатных объектов)
/append - добавление новых данных к уже присутствующим в буфере (применяется только текстовых объектов)
/? - вызов справки

И напоследок приведем несколько команд, демонстрирующих возможности перечисленных утилит.
C:\>getclip.exe > somefile.txt

Данная инструкция извлечет хранимый в буфере обмена Windows текст и переадресует его в файл с именем somefile.txt.
C:\>setclip.exe < setuplog.txt

Эта команда перенаправит содержимое файла setuplog.txt в буфер обмена.
C:\>dir | setclip.exe

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

1. Перед запуском утилит убедитесь в наличии в операционной системе библиотек Visual Basic 5.0/6.0. В случае отсутствия таковых, загрузить недостающие системные файлы можно с этой страницы. [вернуться]

Да этож гений. как то я протупил...

Total Commander + плагин decClipboardFS

когда то писал в качестве примеров для vba называлась taskpane
суть в том что сначала надо создать функциями api шаблон пустого файла(графических есть много все в msdn) а потом вставить туда картинку и записать на диск

(19) А картинки?

(22) Vba в отличии от vb не умеет работать с clipboard.

(21) ПРОГРАММНО, блин!

вытащить картинку из файла excel

Желающие тесты от иметь :-)))

Можно еще вот этим, но не пробовал:
http://www.script-coding.info/WshExtra.zip

Set WshExtra = CreateObject("WshExtra.Clipboard")
MsgBox WshExtra.Paste()

(26) c:\nircmd.exe clipboard saveimage "c:\temp\clip01.png"

(24) Если API воспользоваться то может :-)

(30)Private Declare Auto Function OpenClipboard Lib "User32.dll" (ByVal hWndNewOwner As Integer) As Boolean

http://word.mvps.org/FAQs/MacrosVBA/ManipulateClipboard.htm

(31) в 1С Апи?

в Excel :-) через Оле в 1с модуль создаешь и запускаешь


=======================================================================
Перем ExcelApp;
//*********************************************************************
Процедура глУбратьМенюФайл(ExcelApp)
 ПолныйЗаголовокСистемы="1С:Предприятие - "+СокрЛП(Метаданные.Идентификатор)+": "+ЗаголовокСистемы();
 ExcelApp.DisplayAlerts = 0; // не выводить сообщений и вопросов
 WorkBook = ExcelApp.WorkBooks.Add(); // создание новой книги Excel
 WorkBook.Worksheets.Add(); // создание нового листа в книге Excel
 //добавление нового модуля VBA в книгу Excel и получение ссылки на его код:
 ы = ExcelApp.VBE.ActiveVBProject.VBComponents.Count;
 ExcelApp.VBE.ActiveVBProject.VBComponents.Add(1);
 CodeModule = ExcelApp.VBE.ActiveVBProject.VBComponents.Item(ы + 1).CodeModule;
 //************************************************************************************************
 //=>>Добавление кода VBA *************************************************************************
 //Объявления нужных Win32 API:
 CodeModule.InsertLines(1,  "Public Declare Function GetDesktopWindow Lib ""user32"" () As Long");
 CodeModule.InsertLines(2,  "Public Declare Function EnumChildWindows Lib ""user32"" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long");
 CodeModule.InsertLines(3,  "Public Declare Function GetWindowTextLength Lib ""user32"" Alias ""GetWindowTextLengthA"" (ByVal hwnd As Long) As Long");
 CodeModule.InsertLines(4,  "Public Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long");
 CodeModule.InsertLines(5,  "Public Declare Function GetMenu Lib ""user32"" (ByVal hwnd As Long) As Long");
 CodeModule.InsertLines(6,  "Public Declare Function GetMenuItemCount Lib ""user32"" (ByVal hMenu As Long) As Long");
 CodeModule.InsertLines(7,  "Public Declare Function RemoveMenu Lib ""user32"" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long");
 CodeModule.InsertLines(8,  "Public Declare Function GetMenuItemInfo Lib ""user32"" Alias ""GetMenuItemInfoA"" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpmii As MENUITEMINFO) As Long");
 CodeModule.InsertLines(9,  "Public Declare Function SetTimer Lib ""user32"" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long");
 CodeModule.InsertLines(10, "Public Declare Function KillTimer Lib ""user32"" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long");
 CodeModule.InsertLines(11, "Public Declare Function DrawMenuBar Lib ""user32"" (ByVal hwnd As Long) As Long");
 //Объявления глобальных переменных, констанот и типов:
 CodeModule.InsertLines(12, "Public count_wnd As Long"); //количество найденных окон
 CodeModule.InsertLines(13, "Public hwnd_1C As Long"); //хэндл окна 1С
 CodeModule.InsertLines(14, "Public uIDEvent As Long"); //идентификатор таймера
 CodeModule.InsertLines(15, "Public Type hwnd_app"); //структура, хранящая хэндл и заголовок окна
 CodeModule.InsertLines(16, "    hwnd As Long");
 CodeModule.InsertLines(17, "    caption As String * 1024");
 CodeModule.InsertLines(18, "End Type");
 CodeModule.InsertLines(19, "Public WindowSys() As hwnd_app"); //массив, хранящий хэндлы и заголовки найденных окон
 CodeModule.InsertLines(20, "Public Type MENUITEMINFO"); //структура, хранящая информацию об элементе меню
 CodeModule.InsertLines(21, "    cbSize As Long");
 CodeModule.InsertLines(22, "    fMask As Long");
 CodeModule.InsertLines(23, "    fType As Long");
 CodeModule.InsertLines(24, "    fState As Long");
 CodeModule.InsertLines(25, "    wID As Long");
 CodeModule.InsertLines(26, "    hSubMenu As Long");
 CodeModule.InsertLines(27, "    hbmpChecked As Long");
 CodeModule.InsertLines(28, "    hbmpUnchecked As Long");
 CodeModule.InsertLines(29, "    dwItemData As Long");
 CodeModule.InsertLines(30, "    dwTypeData As String");
 CodeModule.InsertLines(31, "    cch As Long");
 CodeModule.InsertLines(32, "    hbmpItem As Long");
 CodeModule.InsertLines(33, "End Type");
 CodeModule.InsertLines(34, "Public Const MIIM_STRING = &H40");
 CodeModule.InsertLines(35, "Public Const MF_REMOVE = &H1000&");
 CodeModule.InsertLines(36, "Public Const MF_BYPOSITION = &H400");
 //Процедура, находящая хэндл окна 1С:
 CodeModule.InsertLines(37, "Public Sub Find1C_Window()");
 CodeModule.InsertLines(38, "    hwndDesktop = GetDesktopWindow()"); //получение хэндла окна рабочего стола
 CodeModule.InsertLines(39, "    EnumChildWindows hwndDesktop, AddressOf EnumChildProc, ByVal 0&"); //перечисление дочерних окон рабочего стола
 CodeModule.InsertLines(40, "    For i = 1 To count_wnd");
 CodeModule.InsertLines(41, "        If (InStr(WindowSys(i).caption, """+ПолныйЗаголовокСистемы+""") > 0) Then"); //найдено окно 1С
 CodeModule.InsertLines(42, "            hwnd_1C = WindowSys(i).hwnd"); //получение хэндла окна 1С
 CodeModule.InsertLines(43, "            Exit For");
 CodeModule.InsertLines(44, "        End If");
 CodeModule.InsertLines(45, "    Next");
 CodeModule.InsertLines(46, "End Sub");
 //Функция перечисления дочерних окон:
 CodeModule.InsertLines(47, "Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long");
 CodeModule.InsertLines(48, "    Dim sSave As String");
 CodeModule.InsertLines(49, "    sSave = Space$(GetWindowTextLength(hwnd) + 1)");
 CodeModule.InsertLines(50, "    GetWindowText hwnd, sSave, Len(sSave)"); //получение заголовка окна
 CodeModule.InsertLines(51, "    sSave = Left$(sSave, Len(sSave) - 1)");
 CodeModule.InsertLines(52, "    If sSave <> """" Then");
 CodeModule.InsertLines(53, "        count_wnd = count_wnd + 1"); //увеличение счётчика окон
 CodeModule.InsertLines(54, "        ReDim Preserve WindowSys(count_wnd)"); //помещение найденного окна в массив
 CodeModule.InsertLines(55, "        WindowSys(count_wnd).hwnd = hwnd");
 CodeModule.InsertLines(56, "        WindowSys(count_wnd).caption = sSave");
 CodeModule.InsertLines(57, "    End If");
 CodeModule.InsertLines(58, "    EnumChildProc = 1");
 CodeModule.InsertLines(59, "End Function");
 //Процедура перечисления и удаления нужных колонок меню:
 CodeModule.InsertLines(60, "Public Sub DeleteColMenu()");
 CodeModule.InsertLines(61, "    hMenu = GetMenu(hwnd_1C)"); //получение хэндла меню окна 1С
 CodeModule.InsertLines(62, "    nCnt = GetMenuItemCount(hMenu)"); //получение количества колонок меню окна 1С
 CodeModule.InsertLines(63, "    For j = nCnt - 1 To 0 Step -1"); //перечисление колонок меню
 CodeModule.InsertLines(64, "        Dim MII As MENUITEMINFO");
 CodeModule.InsertLines(65, "        MII.cbSize = Len(MII)");
 CodeModule.InsertLines(66, "        MII.fMask = MIIM_STRING");
 CodeModule.InsertLines(67, "        GetMenuItemInfo hMenu, j, True, MII"); //получение информации о пункте меню
 CodeModule.InsertLines(68, "        MII.cch = MII.cch + 100");
 CodeModule.InsertLines(69, "        MII.dwTypeData = Space(MII.cch)");
 CodeModule.InsertLines(70, "        GetMenuItemInfo hMenu, j, True, MII");
 CodeModule.InsertLines(71, "        If InStr(MII.dwTypeData, ""Файл"") > 0 Then"); //удаление меню "Файл"
 CodeModule.InsertLines(72, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
 CodeModule.InsertLines(73, "        End If");
 CodeModule.InsertLines(74, "        If InStr(MII.dwTypeData, ""Сервис"") > 0 Then"); //удаление меню "Сервис"
 CodeModule.InsertLines(75, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
 CodeModule.InsertLines(76, "        End If");
 CodeModule.InsertLines(77, "        If InStr(MII.dwTypeData, ""Окна"") > 0 Then"); //удаление меню "Окна"
 CodeModule.InsertLines(78, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
 CodeModule.InsertLines(79, "        End If");
 CodeModule.InsertLines(80, "        If InStr(MII.dwTypeData, ""Помощь"") > 0 Then"); //удаление меню "Помощь"
 CodeModule.InsertLines(81, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
 CodeModule.InsertLines(82, "        End If");
 CodeModule.InsertLines(83, "    Next");
 CodeModule.InsertLines(84, "    DrawMenuBar hwnd_1C");
 CodeModule.InsertLines(85, "End Sub");
 //Процедура запуска таймера:
 CodeModule.InsertLines(86, "Public Sub InstallTimer()");
 CodeModule.InsertLines(87, "    uIDEvent = SetTimer(0, 1000000, 50, AddressOf DeleteColMenu)");
 CodeModule.InsertLines(88, "End Sub");
 //Процедура уничтожения таймера:
 CodeModule.InsertLines(89, "Public Sub DeleteTimer()");
 CodeModule.InsertLines(90, "    KillTimer 0, uIDEvent");
 CodeModule.InsertLines(91, "End Sub");
 //<<=Добавление кода VBA *************************************************************************
 //************************************************************************************************
 ExcelApp.Application.Run("Find1C_Window"); //получение хэндла окна 1С
 ExcelApp.Application.Run("DeleteColMenu"); //удаление нужных колонок меню
 ExcelApp.Application.Run("InstallTimer"); //запуск таймера
КонецПроцедуры //глУбратьМенюФайл

(34) Это для v7 почти тоже самое и для v8 работает
Процедура ПриНачалеРаботыСистемы()
 Попытка
   ExcelApp = СоздатьОбъект("Excel.Application");
   глУбратьМенюФайл(ExcelApp);
 Исключение
   Предупреждение("Не удалось запустить MS Excel!");
   СтатусВозврата(0);
   Возврат;
 КонецПопытки;
КонецПроцедуры // ПриНачалеРаботыСистемы
//************************************************************************************************
Процедура ПриЗавершенииРаботыСистемы()
 ExcelApp.Application.Run("DeleteTimer");
 ExcelApp.DisplayAlerts=0;
 ExcelApp.Quit();
 ExcelApp="";
КонецПроцедуры // ПриЗавершенииРаботыСистемы

взято отсюда Удалить меню "Файл"

Option Explicit
Sub test()
   Dim oChart As ChartObject, oPic As Picture, w As Long, h As Long, FileName As String
   FileName = ThisWorkbook.Path & "\Test.jpg"
   Application.ScreenUpdating = False
   With ActiveSheet
       Set oPic = .Pictures.Insert("C:\temp\Test.jpg")
       With oPic
           .Height = 175 * (.Height / .Width)
           .Width = 175
           w = .Width
           h = .Height
           .Copy
       End With
       Set oChart = .ChartObjects.Add(10, 10, w, h)
       With oChart.Chart
           .Paste
           .ChartArea.Border.LineStyle = 0
           .ChartArea.ClearContents
           .Export FileName, "JPEG", False
       End With
   End With
   oPic.Delete
   oChart.Delete
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub

Option Explicit

'---------------- Описания структур, функций, констант Win32 API ---------------

Private Type Bitmap '24 bytes
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Declare Function SelectObject Lib "gdi32" ( _
  ByVal hDC As Long, ByVal hObject As Long) As Long
'Private Declare Function DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long) As Long
Private Declare Function GetObjectA Lib "gdi32" ( _
  ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function GetObjectType Lib "gdi32" ( _
  ByVal hgdiobj As Long) As Long
Private Const OBJ_BITMAP = 7

Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
  ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" ( _
  ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
  ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function SetStretchBltMode Lib "gdi32" ( _
  ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Const STRETCH_DELETESCANS = 3
Private Const STRETCH_HALFTONE = 4

Private Declare Function StretchBlt Lib "gdi32" ( _
  ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
  ByVal nWidth As Long, ByVal nHeight As Long, _
  ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
  ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
  ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Private Const PICTYPE_BITMAP = 1

Private Type PicBmp
  Size As Long
  Type As Long
  hBmp As Long
  hPal As Long
  Reserved As Long
End Type

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
  PicDesc As PicBmp, RefIID As GUID, _
  ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

'-------------------------------------------------------------------------------

'Из Q161299
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CreateBitmapPicture
'    - Creates a bitmap type Picture object from a bitmap and
'      palette.
'
' hBmp
'    - Handle to a bitmap.
'
' hPal
'    - Handle to a Palette.
'    - Can be null if the bitmap doesn't use a palette.
'
' Returns
'    - Returns a Picture object containing the bitmap.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CreateBitmapPicture( _
  ByVal hBmp As Long, ByVal hPal As Long) As StdPicture
Dim R As Long
Dim Pic As PicBmp
' IPicture requires a reference to "Standard OLE Types."
Dim IPic As IPicture
Dim IID_IDispatch As GUID

' Fill in with IDispatch Interface ID.
With IID_IDispatch
   .Data1 = &H20400
   .Data4(0) = &HC0
   .Data4(7) = &H46
End With

' Fill Pic with necessary parts.
With Pic
   .Size = Len(Pic)          ' Length of structure.
   .Type = PICTYPE_BITMAP    ' Type of Picture (bitmap).
   .hBmp = hBmp              ' Handle to bitmap.
   .hPal = hPal              ' Handle to palette (may be null).
End With

' Create Picture object.
R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

' Return the new Picture object.
Set CreateBitmapPicture = IPic
End Function


Public Function FitToSizeBitmap( _
  ByVal hBitmap As Long, _
  Optional ByVal nWidth As Long = 0, _
  Optional ByVal nHeight As Long = 0) As StdPicture
Dim bm As Bitmap
Dim cbSize As Long
Dim cbCopied As Long
Dim hdcSrc As Long
Dim hdcDst As Long
Dim hbmpOldSrc As Long
Dim hbmpOldDst As Long
Dim hbmpNew As Long
Dim r0 As Double
Dim nDstWidth As Long, nDstHeight As Long

If (hBitmap = 0) Or (nWidth < 0) Or (nHeight < 0) Then Exit Function
If GetObjectType(hBitmap) <> OBJ_BITMAP Then Exit Function

'Получаем заголовок битмапа, чтобы извлечь из него размеры изображения
'в пикселях
cbSize = LenB(bm)
cbCopied = GetObjectA(hBitmap, cbSize, bm)
If cbCopied <> cbSize Then Exit Function

'Подгонка размера
r0 = bm.bmWidth / bm.bmHeight
If nWidth = 0 Then
   'Пользователя не интересует ширина - вписываем в высоту
   If nHeight = 0 Then
      'Пользователя не интересует и высота - странно. Просто
      'сохраняем оригинальные размеры
      nDstWidth = bm.bmWidth
      nDstHeight = bm.bmHeight
   Else
      nDstHeight = nHeight
      nDstWidth = Int(nDstHeight * r0 + 0.5)
      If nDstWidth <= 0 Then nDstWidth = 1
   End If
ElseIf nHeight = 0 Then
   'Пользователя не интересует высота - вписываем в ширину
   nDstWidth = nWidth
   nDstHeight = Int(nDstWidth / r0 + 0.5)
   If nDstHeight <= 0 Then nDstHeight = 1
Else
   'Пользователь хочет вписать битмап в прямоугольник с размерами
   'не больше заданных
   If r0 < nWidth / nHeight Then
      nDstHeight = nHeight
      nDstWidth = Int(nHeight * r0 + 0.5)
      If nDstWidth <= 0 Then nDstWidth = 1
   Else
      nDstWidth = nWidth
      nDstHeight = Int(nHeight / r0 + 0.5)
      If nDstHeight <= 0 Then nDstHeight = 1
   End If
End If

'Создаём контексты устройств, совместимых с экраном, в памяти
'Картинка будет иметь логическое разрешение, как у экрана (обычно 96 dpi)
hdcSrc = CreateCompatibleDC(0)
hdcDst = CreateCompatibleDC(hdcSrc)

'Создаём битмап, совместимый с оригинальным, в памяти
hbmpOldSrc = SelectObject(hdcSrc, hBitmap)
hbmpNew = CreateCompatibleBitmap(hdcSrc, nDstWidth, nDstHeight)
If hbmpNew = 0 Then
   SelectObject hdcSrc, hbmpOldSrc
   DeleteDC hdcDst
   DeleteDC hdcSrc
   Exit Function
End If
hbmpOldDst = SelectObject(hdcDst, hbmpNew)

'Отрисовываем оригинальный битмап на целевой с перемасштабированием
SetStretchBltMode hdcDst, STRETCH_HALFTONE 'Есть только в ОС с ядром NT
StretchBlt hdcDst, 0, 0, nDstWidth, nDstHeight, _
           hdcSrc, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY

'Создаём StdPicture, владеющий битмапом
Set FitToSizeBitmap = CreateBitmapPicture(hbmpNew, 0)

'Очищаем объекты GDI
SelectObject hdcSrc, hbmpOldSrc
SelectObject hdcDst, hbmpOldDst
'DeleteObject hbmpNew 'Третий параметр OleCreatePictureIndirect,
                     'установленний в TRUE, заставляет убивать битмап
                     'при уменьшении счётчика ссылок на картинку до нуля
DeleteDC hdcDst
DeleteDC hdcSrc
End Function
Это модуль с функцией FitToSizeBitmap(), перемасштабирующей битмап с сохранением пропорций. Желательно выполнять на ОС с ядром NT (NT 4.0, 2000, XP, 2003, Vista). В случае 95/98/Me режима STRETCH_HALFTONE нет (согласно документации - не проверял), придётся пользоваться STRETCH_DELETESCANS, он чуть менее качественный.
Пример использования:

Public Sub Test()
Dim SrcPic As StdPicture, DstPic As StdPicture
Set SrcPic = LoadPicture("C:\test.jpg")
Set DstPic = FitToSizeBitmap(SrcPic.Handle, 175)
SavePicture DstPic, "C:\test1.bmp"
End Sub
Для записи в JPEG требуется, чтобы была установлена библиотека GDI+. Она входит в ОС начиная с XP, для более ранних доступна с сайта MS (1МБ). Наличие на компьютере можно проверить поиском файла GdiPlus.dll.

Option Explicit

Private Type GdiplusStartupInput
  GdiplusVersion           As Long
  DebugEventCallback       As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs   As Long
End Type

Private Type CLSID 'частный вид GUID-а
  Data1         As Long
  Data2         As Integer
  Data3         As Integer
  Data4(0 To 7) As Byte
End Type

Private Enum EncoderParameterValueType
  [EncoderParameterValueTypeByte] = 1
  [EncoderParameterValueTypeASCII] = 2
  [EncoderParameterValueTypeShort] = 3
  [EncoderParameterValueTypeLong] = 4
  [EncoderParameterValueTypeRational] = 5
  [EncoderParameterValueTypeLongRange] = 6
  [EncoderParameterValueTypeUndefined] = 7
  [EncoderParameterValueTypeRationalRange] = 8
End Enum

Private Type EncoderParameter
  GUID           As CLSID
  NumberOfValues As Long
  Type           As EncoderParameterValueType
  Value          As Long
End Type

Private Type EncoderParameters
  Count     As Long
  Parameter As EncoderParameter
End Type

Private Enum GpStatus
  [OK] = 0
  [GenericError] = 1
  [InvalidParameter] = 2
  [OutOfMemory] = 3
  [ObjectBusy] = 4
  [InsufficientBuffer] = 5
  [NotImplemented] = 6
  [Win32Error] = 7
  [WrongState] = 8
  [Aborted] = 9
  [FileNotFound] = 10
  [ValueOverflow] = 11
  [AccessDenied] = 12
  [UnknownImageFormat] = 13
  [FontFamilyNotFound] = 14
  [FontStyleNotFound] = 15
  [NotTrueTypeFont] = 16
  [UnsupportedGdiplusVersion] = 17
  [GdiplusNotInitialized] = 18
  [PropertyNotFound] = 19
  [PropertyNotSupported] = 20
End Enum
Private Type ImageCodecInfo
  ClassID           As CLSID
  FormatID          As CLSID
  CodecName         As Long
  DllName           As Long
  FormatDescription As Long
  FilenameExtension As Long
  MimeType          As Long
  flags             As Long
  Version           As Long
  SigCount          As Long
  SigSize           As Long
  SigPattern        As Long
  SigMask           As Long
End Type

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" ( _
  ByVal hBmp As Long, ByVal hPal As Long, Bitmap As Long) As GpStatus
Private Declare Function GdiplusStartup Lib "gdiplus" ( _
  token As Long, inputbuf As GdiplusStartupInput, _
  Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
  ByVal token As Long) As GpStatus
Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
  ByVal image As Long, ByVal FileNameW As Long, _
  clsidEncoder As CLSID, encoderParams As Any) As GpStatus
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" ( _
  numEncoders As Long, Size As Long) As GpStatus
Private Declare Function GdipGetImageEncoders Lib "gdiplus" ( _
  ByVal numEncoders As Long, ByVal Size As Long, encoders As Any) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
  ByVal image As Long) As GpStatus

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  Dest As Any, Src As Any, ByVal cb As Long) As Long
'Private Declare Function CLSIDFromString Lib "ole32" ( _
  ByVal lpszProgID As Long, pCLSID As CLSID) As Long
Private Declare Function lstrlenW Lib "kernel32" ( _
  ByVal psString As Any) As Long

'Private Const EncoderQuality$ = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private GdIHandle As Long

Public Function SavePictureToJPEG( _
  Picture As StdPicture, FileName As String, JPGQuality As Long) As Boolean
Dim gplRet      As Long
Dim hImg        As Long
Dim uEncCLSID   As CLSID
Dim uEncParams  As EncoderParameters

Dim GpInput As GdiplusStartupInput
GpInput.GdiplusVersion = 1
If GdiplusStartup(GdIHandle, GpInput) <> [OK] Then Exit Function
If JPGQuality > 100 Then JPGQuality = 100
If JPGQuality < 1 Then JPGQuality = 1

'-- Create bitmap from HBITMAP
gplRet = GdipCreateBitmapFromHBITMAP(Picture.Handle, Picture.hPal, hImg)
If gplRet = [OK] Then
   
   GetEncoderClsID "image/jpeg", uEncCLSID
   'Установка качества
   uEncParams.Count = 1
   With uEncParams.Parameter
      .NumberOfValues = 1
      .Type = [EncoderParameterValueTypeLong]
      With .GUID
         .Data1 = &H1D5BE4B5
         .Data2 = &HFA4A
         .Data3 = &H452D
         .Data4(0) = &H9C
         .Data4(1) = &HDD
         .Data4(2) = &H5D
         .Data4(3) = &HB3
         .Data4(4) = &H51
         .Data4(5) = &H5
         .Data4(6) = &HE7
         .Data4(7) = &HEB
      End With
      'CLSIDFromString StrPtr(EncoderQuality), .GUID
      .Value = VarPtr(JPGQuality)
   End With
   gplRet = GdipSaveImageToFile(hImg, StrPtr(FileName), uEncCLSID, uEncParams)
   SavePictureToJPEG = gplRet = [OK]
   gplRet = GdipDisposeImage(hImg)
End If

GdiplusShutdown GdIHandle
End Function

Private Function GetEncoderClsID(strMimeType As String, ClassID As CLSID)
Dim Num As Long, Size As Long, i As Long
Dim ICI()    As ImageCodecInfo
Dim Buffer() As Byte

GetEncoderClsID = -1
GdipGetImageEncodersSize Num, Size
If Size = 0 Then Exit Function
ReDim ICI(1 To Num) As ImageCodecInfo
ReDim Buffer(1 To Size) As Byte
GdipGetImageEncoders Num, Size, Buffer(1)
CopyMemory ICI(1), Buffer(1), (Len(ICI(1)) * Num)
For i = 1 To Num
   If StrComp(LPWSTR2String(ICI(i).MimeType), strMimeType, _
              vbTextCompare) = 0 Then
      ClassID = ICI(i).ClassID
      GetEncoderClsID = i
      Exit For
   End If
Next
Erase ICI
Erase Buffer
End Function

Private Function LPWSTR2String(ByVal lpWStr As Long) As String
Dim nStrLen As Long
nStrLen = lstrlenW(lpWStr)
LPWSTR2String = String$(nStrLen, vbNullChar)
CopyMemory ByVal StrPtr(LPWSTR2String), ByVal lpWStr, nStrLen * 2
End Function
Это модуль с функцией SavePictureToJPEG(). Пример использования:

Public Sub Test()
Dim SrcPic As StdPicture, DstPic As StdPicture
Set SrcPic = LoadPicture("C:\test.jpg")
Set DstPic = FitToSizeBitmap(SrcPic.Handle, 175)
SavePicture DstPic, "C:\test1.bmp"
SavePictureToJPEG  DstPic, "C:\test1.jpg", 80
Set DstPic = FitToSizeBitmap(SrcPic.Handle, 75)
SavePicture DstPic, "C:\test2.bmp"
SavePictureToJPEG  DstPic, "C:\test2.jpg", 80
End Sub

Блин, офигеть. Конкретное удаление гланд через п..у.
Если бы я хотел через офис взять, я бы вставил из буфера в ворд, а потом бы выделил все и скопипастил в HTML, Там была бы ссылка на временный файл, куда она положила картинку. Но на компе может не быть ворда.