'How to control image transparency?
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 1:[1]
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.
Solution 2:[2]
I just ran across this excellent routine last week and tried it. The only downfall I noticed is that because the shape is Selected, when the For ... Next loops run the Selection Handles are visible on the shape. I also saw the question posted by Princess.Bell: "is there anyway to add a background image to the shape?" I have an update to this posting which addresses both issues. I also slowed the fade in and fade out by adjusting the "timer" in the For ... Next loops from 100 to 250. This allows the fade in and fade out process to take place over 0.5 second.
Sub FadeInFadeOut()
Dim shp As Shape
Set shp = Sheets("Sheet1").Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=35, Top:=117, Width:=72.75, Height:=25.5)
Dim i As Integer
With shp.Fill
.Visible = msoTrue
.UserPicture FileName '==> C:\Users\Me\AppData\Local\Temp\SavedImage.jpg (image file)
For i = 1 To 250 'Fade in shape/picture.
.Transparency = 1 - i / 250
DoEvents
Next
For i = 1 To 250 'Fade out shape/picture.
.Transparency = i / 250
DoEvents
Next
End With
shp.Delete 'Discard the shape now that we're done using it.
Range("C3").Select 'Position cursor.
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | |
Solution 2 | Smiley |