transparent

Option Explicit
' Userform Transparent
' Ref : [url=http://www.tek-tips.com/viewthread.cfm?qid=970078]VBA Visual Basic for Applications (Microsoft) - Transparent (See through) userforms in Excel[/url]

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&

Public hWnd As Long

Private Sub UserForm_Initialize()
Dim bytOpacity As Byte
bytOpacity = 100 ' variable keeping opacity setting
hWnd = FindWindow("ThunderDFrame", Me.Caption)
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(Me.hWnd, 0, bytOpacity, LWA_ALPHA)
End Sub

Sub Fondu()
'un clic sur l'image relance la macro
Dim dur#, deb#
dur = 15 'durée en secondes à ajuster
Application.DisplayFullScreen = True
With Feuil1.Shapes("MonCache")
  .Height = ActiveWindow.VisibleRange.Height
  .Fill.Transparency = 0
  With Feuil1.Shapes("MonImage")
    .Height = ActiveWindow.VisibleRange.Height
    .Visible = True
  End With
  deb = Timer
  While Timer < deb + dur
    If Timer - Application.Floor(Timer, 0.05) < 0.01 Then
      .Fill.Transparency = (Timer - deb) / dur
      DoEvents
    End If
  Wend
  .Fill.Transparency = 1
End With
End Sub

Private Sub Workbook_activate()
Fondu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
With Feuil1
  .Shapes("MonImage").Visible = False
  .Shapes("MonCache").Fill.Transparency = 0
  Application.Goto .[A1], True
End With
Me.Save
If Workbooks.Count = 1 Then Application.Quit
End Sub