Function PictureWithTransparence(chemin, Optional couleur As Long = -1)
Dim fichier$, HandleClipImage&, retour
With ActiveSheet
.Pictures.Insert (chemin)
If couleur <> -1 Then
With .Shapes(.Shapes.Count).PictureFormat
.TransparentBackground = True: .TransparencyColor = couleur: .Parent.Fill.Visible = False
End With
End If
With .Shapes(.Shapes.Count): .CopyPicture: .Delete: End With
fichier = ThisWorkbook.Path & "\pict.wmf"
ExecuteExcel4Macro ("CALL(""user32"",""OpenClipboard"",""JJ""," & 0& & ")")
HandleClipImage = ExecuteExcel4Macro("CALL(""user32"",""GetClipboardData"",""JJ""," & &HE & ")")
retour = ExecuteExcel4Macro("CALL(""gdi32"",""CopyEnhMetaFileA"",""JJC""," & HandleClipImage& & ",""" & fichier & """)")
ExecuteExcel4Macro ("CALL(""gdi32"",""DeleteEnhMetaFile"",""JJ""," & retour & ")")
ExecuteExcel4Macro ("CALL(""user32"",""CloseClipboard"",""J"")")
Application.OnTime Now + 0.00001, "killimage"
End With
PictureWithTransparence = fichier
End Function
Sub killimage(): Kill ThisWorkbook.Path & "\pict.wmf": End Sub