Insert Size Shape and Transparent Background Image

[alexg7828]

I am making progress. At the moment I can add an image to a cell, size it to a specific range but thats where I am stuck.

Now I would like to be able to select an image in a specific range and change the background colour (white) to transparent. Any ideas?

My attempt is in red below

LookupOCMsignature


If Dir(OCMsignaturePath) <> vbNullString Then


With ActiveSheet.Pictures.Insert(OCMsignaturePath)
    If .Width / .Height < 2.575 Then
     .Top = Range("OCMsignature").Top + 1
     .Height = Range("OCMsignature").MergeArea.Height - 1
     .Left = Range("OCMsignature").Left + (Range("OCMsignature").MergeArea.Width - .Width) / 2
     .ShapeRange.LockAspectRatio = msoTrue
     Else
     .Left = Range("OCMsignature").Left + 1
     .Width = Range("OCMsignature").MergeArea.Width - 1
     .Top = Range("OCMsignature").Top + (Range("OCMsignature").MergeArea.Height - .Height) / 2
     .ShapeRange.LockAspectRatio = msoTrue
     End If
End With
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]    For Each Picture In ActiveSheet.Pictures[/COLOR]
[COLOR=#ff0000]        If Not Intersect(pic.TopLeftCell, Range("A488:E500")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]            .PictureFormat[/COLOR]
[COLOR=#ff0000]            .TransparentBackground = True[/COLOR]
[COLOR=#ff0000]            .TransparencyColor = vbWhite[/COLOR]
[COLOR=#ff0000]        .Fill.Visible = False[/COLOR]


Else
If dispMsgBox = True Then
MsgBox OCMsignaturePath & vbCrLf & "This link to the image is not available. Please check the availability of the file in the right directory"
End If
End If


End Sub