[英]vba control image transparency possible?
我的工作表中有一個要淡出的圖像。 為此,我想找到一種為圖像設置不同透明度階段的方法,如下所示:
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
目前我收到一條不支持對象的錯誤消息,這讓我相信這可能是不可能的。
如果可能,請somoene 告訴我如何做到這一點? 謝謝
我花了很長時間才能DoEvents
工作(直到我嘗試了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
它適用於我在圖紙上放置的自選圖形。
注意:
您必須將100調整為淡入/淡出速度。
編輯#1:
這是一些垃圾代碼(基於記錄器),用於將自選圖形放到圖紙上並用圖片填充:
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
記住要命名形狀,並在所有引用該形狀的代碼中使用該名稱。
上周我剛剛遇到了這個出色的例程並嘗試了它。 我注意到的唯一缺點是因為形狀被選中,當 For ... Next 循環運行時,選擇手柄在形狀上可見。 我也看到了Princess.Bell 貼的問題:“有沒有辦法給形狀添加背景圖片?” 我對這篇文章有一個更新,它解決了這兩個問題。 我還通過將 For ... Next 循環中的“計時器”從 100 調整到 250 來減緩淡入和淡出。這允許淡入和淡出過程發生在 0.5 秒以上。
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.