Effect "Fade in and Delete - VBA"

Question

Effect "Fade in and Delete - VBA"

Navigation

#1 by (0 votes)

0

I am having a question in VBA - MS EXCEL 2016

I need to create a macro that when I trigger it, it searches for an image.png on my computer and inserts it on the worksheet with the gradual effect of Fade-in. After that, the image should appear for 3 seconds and the effect of "Delete" should occur in order to avoid disturbing the editing of the worksheet.

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

Could you guys please help me with the encoding?

Thank you!

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

excel vba

asked by anonymous 12.08.2018 / 04:51

1 answer

customize validator.js when leaving the field Scroll down to Facebook DIV or Load conversations without scrolling down

score 0 · Answer 1

The problem is that when you insert as Image Shape, changing the transparency is not possible. You must first insert an AutoShape.

Steps

Create an AutoShape on the Active Sheet (a rectangle or other shape)

Fill Shape with the desired image

Loop to change transparency to cause Fade in effect

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