[UserForm P5] Transparence + Démo P2 à P5
Ce dernier tuto de la série permet d'appliquer deux modes de transparence sur l'UserForm.
- > Graduation de la transparence sur l'ensemble de l'UF, UF et contrôles
- > L'UF transparent et graduation de la transparence des contrôles.
Vous pouvez télécharger le classeur démo ici :
Application de la transparence sur l'ensemble de l'UserForm
Application de la transparence totale sur l'UserForm ..
Application de la transparence totale sur l'UserForm et graduée sur les contrôles.
Suppression du cadre de l'UserForm
Arrondi des angles
Arrondir les angles de façon irrégulière (Ovale)
Les images ne sont pas très plaisantes mais j'ai essayé de démontrer au maximum les possibilités offertes en employant un seul UserForm.
Il est évident que vous devez adapter la présentation aux options retenues, par exemple:
l'image qui est tronquée quand on applique un arrondi.
A vous de soigner le design dans votre application.
Le code pour la transparence
Dans un module général (Module1 par exemple)
Option Explicit
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 crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE As Long = (-20)
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_ALPHA As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000
Public Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Function WndSetOpacity(ByVal hwnd As Long, Optional ByVal crKey As Long = vbBlack, Optional ByVal Alpha As Byte = 255, Optional ByVal ByAlpha As Boolean = True) As Boolean
' Return : True si il n'y a pas eu d'erreur.
' hWnd : hWnd de la fenêtre à rendre transparente
' crKey : Couleur à rendre transparente si ByAlpha=False (utiliser soit les constantes vb:vbWhite ou en hexa:&HFFFFFF)
' Alpha : 0-255 0=transparent 255=Opaque si ByAlpha=true (défaut)
On Error GoTo Lbl_Exit
Dim ExStyle As Long
ExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
If ExStyle <> (ExStyle Or WS_EX_LAYERED) Then
ExStyle = (ExStyle Or WS_EX_LAYERED)
Call SetWindowLong(hwnd, GWL_EXSTYLE, ExStyle)
End If
WndSetOpacity = (SetLayeredWindowAttributes(hwnd, crKey, Alpha, IIf(ByAlpha, LWA_COLORKEY Or LWA_ALPHA, LWA_COLORKEY)) <> 0)
Lbl_Exit:
If Not Err.Number = 0 Then Err.Clear
End Function
Public Sub ActiveTransparence(stCaption As String, d As Boolean, F As Boolean, Couleur As Long, Transparence As Integer)
Dim B As Boolean
Dim lHwnd As Long
'- Recherche du handle de la fenêtre par son Caption
lHwnd = FindWindowA(vbNullString, stCaption)
If lHwnd = 0 Then
MsgBox "Handle de " & stCaption & " Introuvable", vbCritical
Exit Sub
End If
If d And F Then
B = WndSetOpacity(lHwnd, Couleur, Transparence, True)
ElseIf d Then
'B = WndSetOpacity(M.hwnd, , 255, True)
B = WndSetOpacity(lHwnd, , Transparence, True)
Else
B = WndSetOpacity(lHwnd, , 255, True)
End If
End Sub
Dans l'UserForm pour l'appel de la fonction.
Sub AppliqueTransp()
'CheckBox2.Value = True ou False
'ScrollBar1.Value de 35 à 255. En dessous de 35 vous n'avez plus accès à l'Userform
ActiveTransparence Me.Caption, True, CheckBox2.Value, Me.BackColor, ScrollBar1.Value
End Sub
Conseil :
Si Vous employez plusieurs options mettez les codes dans des modules différent pour éviter les double emploi d'API.
Bonjour,
j'ai adapé votre code pour rendre mon fond d'userform transparent:
J'ai mis juste un scrollbar et mis les codes dans un module ModTransparence et dans l'userform.
Quand j'active le curseur, j'ai un message d'erreur ? Erreur de compilation variable non définie.
Pouvez-vous m'aider s'il vous plaît.
Cordialement
J.J Martin