如何控制图像透明度？

Question

我的工作表中有一张图片我想淡出。

我想为图片设置不同的透明度阶段：

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

我收到一条错误消息。

object not supported

Answer 1

我花了很长时间才让它工作（直到我尝试了 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

它适用于我放在 sheet 上的自选图形。

注意：

你必须调整100来调整淡入/淡出速度。

编辑#1：

这是一些垃圾代码（基于记录器），用于在 sheet 上放置自选图形并用图片填充它：

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

记住为形状命名并在引用该形状的所有代码中使用该名称。

Answer 2

上周我刚刚运行完成了这个出色的例程并尝试了它。我注意到的唯一缺点是，因为选中了形状，当 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

如何控制图像透明度？

How to control image transparency?

excel

transparency

vba

image