Private Sub CommandButton2_Click()
Dim hCopy&
Dim iPic As IPicture
Dim tIID As GUID
Dim tPICTDEST As PICTDESC
Dim Ret As Long
Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
TT = 0.5 + Timer: Do While Timer < TT: DoEvents: Loop
' A adapter ////////////////
Chemin = ThisWorkbook.Path & "\"
Fichier = "Toto2.jpg" ' Tu peux mettre Toto3.bmp, ça fonctionne aussi (ou toto4.gif)
'///////////////////////////
OpenClipboard 0&
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy = 0 Then Exit Sub
Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)
If Ret Then Exit Sub
With tPICTDEST
.cbSize = Len(tPICTDEST)
.picType = 1
.hImage = hCopy
End With
Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)
SavePicture iPic, Chemin & Fichier
Set iPic = Nothing
End Sub