[FIXED] How to control image transparency?

Issue

I have an image in my worksheet I want to fade out.

I am tying to set different stages of transparency for the image:

Set myPicture = ActiveSheet.Pictures.Insert(pic)

With myPicture
    .Transparency = 0.5
    Application.Wait (Now + TimeValue("00:00:01"))
    .Transparency = 0.3
    Application.Wait (Now + TimeValue("00:00:01"))
    .Transparency = 0.1
    Application.Wait (Now + TimeValue("00:00:01"))
    .Delete
End With

I get an error message.

object not supported

Solution

It took me a long time to get this to work (until I tried the DoEvents)

Sub FadeInFadeOut()
    Dim r As Range
    Set r = Selection
    ActiveSheet.Shapes("Rectangle 1").Select
    Selection.ShapeRange.Fill.Transparency = 1

    For i = 1 To 100
        Selection.ShapeRange.Fill.Transparency = 1 - i / 100
        DoEvents
    Next

    For i = 1 To 100
        Selection.ShapeRange.Fill.Transparency = i / 100
        DoEvents
    Next

    r.Select
End Sub

It works on an AutoShape I place on the sheet.

NOTE:

You must adjust the 100 to adjust the fade-in / fade-out speed.

EDIT#1:

Here is some junk code (based on the Recorder) for dropping an AutoShape on a sheet and filling it with a Picture:

Sub PicturePlacer()
    Dim sh As Shape

    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 312.75, 176.25, 266.25, 129.75). _
        Select

    Selection.Name = "Sargon"

    Application.CommandBars("AutoShapes").Visible = False
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "123"
    Range("G5").Select
    ActiveSheet.Shapes("Sargon").Select
    Selection.ShapeRange.Fill.Transparency = 0.56
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.UserPicture "C:\Users\garys\Pictures\babies.jpeg"
End Sub

Remember to Name the Shape and use that Name in all the codes that reference that Shape.

Answered By - Gary's Student

Answer Checked By - Willingham (PHPFixing Volunteer)