"Fade in and Delete - VBA" effect

Asked

Viewed 204 times

0

for kindness, I’m with a doubt in VBA - MS EXCEL 2016

I need to create a macro that when I trigger it, it looks for a.png image on my computer and inserts it on the spreadsheet with the gradual effect of Fade-in. After that, the image should appear for 3 seconds and there should be the effect of "Delete" of the image, not to disturb the editing of the spreadsheet.

I tried several macro methods for this solution, and always something wrong.

Please, you could help me with the coding?

Thank you very much!

Note: The code I was using was:

Sub Imagem_na_Planilha()

 Dim Plan As Worksheet, Imagem As Shape
 Dim Clear As Double
 Set Plan = ActiveSheet
 Set Imagem = Plan.Shapes.AddPicture("C:\Downloads\gg.PNG", msoFalse, msoCTrue, 50, 100, 170, 70)

 End Sub

1 answer

0

The problem is that when inserting as Image Shape, changing the transparency is not possible. You need to first insert an Autoshape.

Footsteps

  1. Create an Autoshape in the Active Worksheet (a rectangle or other form)
  2. Fill the Shape with the desired image
  3. Loop change transparency to cause the Fade in effect
  4. Wait 3000 ms and delete the image

Code

Follow the code with an example of how to do this:

Option Explicit
'Declara função Sleep
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub Imagem_na_Planilha()

    Dim Plan As Worksheet, Imagem As Shape
    Dim I As Long

    Set Plan = ActiveSheet
    Set Imagem = Plan.Shapes.AddShape(msoShapeRectangle, 50, 100, 170, 70)
    Imagem.Name = "imagem"
    Plan.Shapes("imagem").Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture "C:\TestFolder\imagem.jpeg"
        .TextureTile = msoFalse
        .Transparency = 1
        'Fade in
        For I = 1 To 100
            .Transparency = 1 - I / 100
            DoEvents
        Next
    End With
    Sleep (3000)
    Plan.Shapes("imagem").Delete
End Sub

Browser other questions tagged

You are not signed in. Login or sign up in order to post.