VBA - TimeredShape with FadeIn - FadeOut effect

Oggi inizio la pubblicaizone di alcune procedure VBA che uso con Excel.
Quella di oggi serve per visualizzare una shape, più spesso una casella di testo, per un tempo determinato con un effetto dissolvenza in entrata e in uscita, un po' come quello della nova mail in arrivo di outlook.

Per il funzionamento di questa procedura servono alcune funzioni:

1. Dichiarare la funzione sleep del kernel, che permetet di definire delle pause in millisecondi senza sprecare cpu.
2. Procedura FadeInOut, che applica l'efeftto dissolvenza, i parametri sono:
   Oggetto shape al quale applicare l'effetto,
   valore Tree/False per indicare rispettivamente FadeIn o FadeOut,
   durata dell'effetto in msec.
3. Funzione rgbLum che applica una luminosità in % ad un colore, i parametri sono:
   R,G,B (colore di base), L luminosità compresa tra 0 e 100
4. Procedura splitRGB traduce nei 3 componenti rgb un colore, i parametri sono:
   l_RGBcolor: colore da trasformare,
   r,g,b: valori in output che conterrano le 3 componenti del colore.

I parametri della procedura principale TimeredShape sono:
Oggetto shape da mostrare;
Tempo di visualizzazione in msec (default 5)
Tempo dell'effetto dissolvenza

[english]
Today I begin the publication of some VBA procedure that I currently use.
TimeredShape is useful for displaying a shape with fadein effect, after waiting for a time in milliseconds hide that with fadeout effect.

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub FadeInOut(s As Shape, _
              Optional bFadeIN As Boolean = True, _
              Optional lDelayMS As Long = 1000)
Dim i As Integer
Dim iBegin As Integer, iEnd As Integer, iStep As Integer
Dim lDelay As Long
Dim l_Trsp As Long                               ' Final Ttransparency / Trasparenza definitiva
Dim l_ForeColor As Long                          ' Border final color / Colore definitivo bordo
Dim bTrasp As Boolean                            ' Trasparenzy are applicable ? / Trasperenza applicabile ?
Const kScala As Integer = 100
  
  lDelay = CLng(lDelayMS / kScala)               ' Calculate step delay /Calcola il ritardo per ogni step
  Dim r As Integer, g As Integer, b As Integer
  
  l_ForeColor = s.Line.ForeColor                 ' Store line color / Determino il colore dell'oggetto
  splitRGB l_ForeColor, r, g, b                  ' Retrieve r,g,b components / Scompongo i valori RGB
  If s.AutoShapeType <> msoShapeMixed Then       ' Aplly only for fillable shape / Applico solo x shape con proprietà Fill
    l_Trsp = s.Fill.Transparency * kScala        ' Store transparency value / Valore Trasparenza dell'oggetto
    bTrasp = True
  Else
    l_Trsp = 0
    bTrasp = False
  End If
    
  If bFadeIN Then                                ' Define Fade paramters / Definisce i parametri per Fade In e Fade Out
    iBegin = kScala
    iEnd = 0
    iStep = -1
  Else
    iBegin = 0
    iEnd = kScala
    iStep = 1
  End If
  lDelay = lDelay * Abs(iStep)                   ' 
    
  s.Line.ForeColor.RGB = rgbLum(r, g, b, iBegin) ' Initialize colour / Inizializzo il colore
  If bTrasp Then
    s.Fill.Transparency = (l_Trsp + (100 - l_Trsp) * iBegin / kScala) / kScala
  End If
  s.Visible = True                               ' Show shape / Mostra l'oggetto
  For i = iBegin To iEnd Step iStep              ' Fade effect / Effetto dissolvenza
    s.Line.ForeColor.RGB = rgbLum(r, g, b, i)    ' Apply color to border line / Applico il colore alla linea del brodo
    If bTrasp Then                               ' Apply transparency / Applico la trasparenza se esiste fill
      s.Fill.Transparency = (l_Trsp + (100 - l_Trsp) * i / kScala) / kScala
    End If
    DoEvents
    Sleep lDelay
  Next i
  s.Visible = bFadeIN                            ' Show/Hide shape / Mostra/Nasconde oggetto
  If bFadeIN = False Then                        
    s.Line.ForeColor.RGB = l_ForeColor           ' Reapply original colour / Riapplico il colore originale
    If bTrasp Then                               ' 
      s.Fill.Transparency = l_Trsp / kScala      ' Reapply original transparency / Riapplico la trasparenza iniziale
    End If
  End If

    
End Sub
'
' Return color with luminance in % 100=White
' Restituisce il colore corrispondente con una luminosità in %  100%=bianco
'
Function rgbLum(r As Integer, g As Integer, b As Integer, l As Integer) As Long
' Red, Green, Blue, Luminance%
  rgbLum = RGB(r + (255 - r) * l / 100, g + (255 - g) * l / 100, b + (255 - b) * l / 100)
End Function
'
' Retrieve RGC colour component from RGB colour
' Scompone un colore RGB nei 3 componenti
'
Sub splitRGB(lRGBcolor As Long, r As Integer, g As Integer, b As Integer)
Dim s As String
  
  s = Right$("000000" & Hex$(lRGBcolor), 6)
  r = Val("&h" & Mid$(s, 1, 2))
  g = Val("&h" & Mid$(s, 3, 2))
  b = Val("&h" & Mid$(s, 5, 2))
End Sub
' ' Display a shape for a time in msec whith fade effect
' Mostra una shape per i millisecondi indicati + il doppio del tempo di dissolvenza indicato
'
Sub TimeredShape(s As Shape, Optional l_DisplayTimeMS As Long = 5000, Optional l_FadeTime As Long = 2000)
  FadeIn s, True, l_FadeTime
  Sleep l_DisplayTimeMS
  FadeInOut s, False, l_FadeTime
End Sub