Как Clipboard записать в Файл?

[tony1]

Как в Excel Clipboard (c картинкой) записать в Файл? (через savepicture)

ps заранее спасибо

[Igor_123]

Вот встретил на
http://www11.brinkster.com/binoj/vbhowto.htm

Код: Выделить всё

How to copy an image from one Picture Box to another Picture Box using the Clipboard? Place this Command1_Click() 

  ' Clear the Clipboard if it's another type of data in the Clipboard.
  Clipboard.Clear
  Clipboard.SetData Picture1.Picture

Place this Command2_Click() 

  ' Copy Clipboard text to Text2.
  Picture2.Picture = Clipboard.GetData




[GSerg]

В Экселе нет Clipboard.
Зато в Экселе есть DataObject. Правда, толку от него мало

Код: Выделить всё

Option Explicit

Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long

Private Const CF_BITMAP As Long = 2
Private Const IMAGE_BITMAP As Long = 0

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

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

Private Function GetPicture(ByVal hPic As Long, ByVal PicType As Long) As IPictureDisp
 
  Dim p As PicBmp, g As GUID
 
  With p
    .hBmp = hPic
    .Size = Len(p)
    .Type = PicType
  End With
 
  'IDispatch
  With g
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
  End With
 
  OleCreatePictureIndirect p, g, 1, GetPicture
End Function

Public Sub SaveClipboardPicture(SaveTo As String)
  OpenClipboard 0
  If IsClipboardFormatAvailable(CF_BITMAP) Then SavePicture GetPicture(CopyImage(GetClipboardData(CF_BITMAP), IMAGE_BITMAP, 0, 0, 0), 1), SaveTo
  CloseClipboard
End Sub

Public Sub sdgfh()
  SaveClipboardPicture "c:\1.bmp"
End Sub