Private Sub Command1_Click()
Set Picture1.Picture = LoadImageFromRES(101, "CUSTOM")
End Sub

Private Declare Function GlobalAlloc Lib "kernel32" ( _
  ByVal wFlags As Long, _
  ByVal dwBytes As Long) As Long
 
Private Declare Function GlobalFree Lib "kernel32" ( _
  ByVal hMem As Long) As Long
 
Private Declare Function GlobalLock Lib "kernel32" ( _
  ByVal hMem As Long) As Long
 
Private Declare Function GlobalUnlock Lib "kernel32" ( _
  ByVal hMem As Long) As Long
 
Private Declare Function CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  lpvDest As Any, _
  lpvSource As Any, _
  ByVal nByte As Long) As Long
 
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" ( _
  ByVal hGlobal As Long, _
  ByVal fDeleteOnRelease As Long, _
  lpIStream As IUnknown) As Long
 
Private Declare Function OleLoadPicture Lib "oleaut32.dll" ( _
  ByVal lpStream As IUnknown, _
  ByVal lSize As Long, _
  ByVal fRunmode As Long, _
  riid As Any, _
  lpIPicture As IPicture) As Long
 
Public Function LoadImageFromRES(ByVal nResID As Long, sType) As StdPicture
  Dim hMem As Long
  Dim pMem As Long
  Dim IStream As IUnknown
  Dim IID_IPicture(3) As Long
  Dim oPicture As IPicture
  Dim nSize As Long
  Dim bImg() As Byte
 
  bImg = LoadResData(nResID, sType)
 
  nSize = UBound(bImg) + 1
 
  hMem = GlobalAlloc(GMEM_MOVEABLE, nSize)
  pMem = GlobalLock(hMem)
  If hMem <> 0 And pMem <> 0 Then
    CopyMemory ByVal pMem, bImg(0), nSize
    GlobalUnlock hMem
    IID_IPicture(0) = &H7BF80980
    IID_IPicture(1) = &H101ABF32
    IID_IPicture(2) = &HAA00BB8B
    IID_IPicture(3) = &HAB0C3000
 
    If CreateStreamOnHGlobal(pMem, Abs(True), IStream) = 0 Then
      If OleLoadPicture(IStream, nSize, 0, IID_IPicture(0), oPicture) = 0 Then
        Set LoadImageFromRES = oPicture
      Else
        MsgBox "Grafik konnte nicht geladen werden"
      End If
    Else
      MsgBox "OLE-Stream konnte nicht erstellt werden"
    End If
 
    Call GlobalFree(hMem)
  Else
    MsgBox "zu wenig Speicher"
    If hMem <> 0 Then Call GlobalFree(hMem)
  End If
End Function