Difficultés face à la création d'une userform

i0raek

XLDnaute Occasionnel
Bonjour à tous !

Voici mon problème :
sur un fichier excel j'ai une userform fixe, que l'utilisateur ne peut fermer, qui rassemble un certain nombre d'information.
Comme cette userform occupe une place significative à l'écran, je souhaiterai :
1°) la rendre transparente (ce que j'ai fait)
2°) afficher ou masquer toute partie de la userform à l'exception de la barre de titre qui doit rester visible en permanence (de préférence...)

En cherchant, j'ai trouvé ce fil :
https://www.excel-downloads.com/threads/probleme-userform-transparent-voir-fichier.1753/


Le fichier correspond presque à ce que je cherche à faire sauf que :
1°) les labels et autres boutons ne disparaissent pas (mais il existe des tuto sur le net qui expliquent comment faire donc ca c'est bon...)
2°) la barre de titre disparait ce qui m'embête un peu...

Enfin, car j'avoue avoir un peu de mal, que signifie ce code ???
Code:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private frmRegion As Long, hWnd As Long, msg1 As String, msg2 As String



Private Sub changeFormEffect()
  Dim W As Single, H As Single, cl As Long, ct As Long, cw As Long, ch As Long
  Dim i As Integer, R As Long, Outer As Long, Inner As Long
  ' Excel affiche en points mais les API utilisent des pixels
  ' 1 pixel = 0.75 point / 1 point = 1.33 pixel
    
  hWnd = FindWindow(vbNullString, Me.Caption)
  W = Me.Width * 1.33: H = Me.Height * 1.33
  If Status = 0 Then
    frmRegion = CreateRectRgn(0, 0, W, H)
    SetWindowRgn hWnd, frmRegion, True
    Exit Sub
  End If
  frmRegion = CreateRectRgn(0, 0, 0, 0)
  ' Mesure des encadrements et hauteur de barre de titre
  ' X = (W - ScaleWidth) / 2 -> Généralement 3
  ' Y = H - X - ScaleHeight  -> Généralement 22
  Const X As Single = 3: Const Y As Single = 22
  Const RGN_OR = 2            ' Crée l'union de régions combinées
  Const RGN_DIFF = 4          ' Crée l'intersection de régions combinées
  ' Obtention de l'encadrement
  If Status = 1 Then
    Outer = CreateRectRgn(0, 0, W, H)
    Inner = CreateRectRgn(X, Y, W - X, H - X)
    CombineRgn frmRegion, Outer, Inner, RGN_DIFF
  End If
  ' Combinaison des regions correpondant aux contrôles
  For i = 0 To Me.Controls.Count - 1
    If Me.Controls(i).Visible Then
      ct = Y + (1.33 * Me.Controls(i).Top): ch = ct + (1.33 * Me.Controls(i).Height)
      cl = X + (1.33 * Me.Controls(i).Left): cw = cl + (1.33 * Me.Controls(i).Width)
      R = CreateRectRgn(cl, ct, cw, ch)
      CombineRgn frmRegion, R, frmRegion, RGN_OR
    End If
  Next
  SetWindowRgn hWnd, frmRegion, True
End Sub

Status prenant comme valeur 0,1 ou 2

Voila, si quelqu'un veut bien éclairer ma lanterne...

Merci d'avance pour votre aide !!!
 
G

Guest

Guest
Re : Difficultés face à la création d'une userform

bonjour,

Dans ces cas là plutôt que d'utiliser des procédures compliquées avec les api windows j'utilise ce genre d'astuce:

Code:
Dim HauteurUsf As Single
Private Sub UserForm_Click()
    If Me.Height < HauteurUsf Then Me.Height = HauteurUsf Else Me.Height = 30
End Sub

Private Sub UserForm_Initialize()
HauteurUsf = Me.Height
End Sub

C'est simple et ça coûte pas cher

bon courage
 

i0raek

XLDnaute Occasionnel
Re : Difficultés face à la création d'une userform

Bonjour Hasco !

C'est Génial !!! je n'avais pas du tout pensé à ca et c'est une super idée... pourquoi cherché simple quand on peut faire compliqué !!!

Par contre, je me suis rendu compte que j'étais un peu trop confiant...
La userform que j'utilise a la propriété suivante :
Code:
showmodal = false

Et je pensais que le fait de cliquer sur la feuille excel est equivalent à
Code:
Sub UserForm_Deactivate()

Et en fait non...
Quel évenement correspondrait au fait de cliquer en dehors de la userform ?
 

abtony

XLDnaute Impliqué
Re : Difficultés face à la création d'une userform

re,

si tu veut masquer ton userform au clik sur ta feuille,

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
userform.Hide
End Sub

si j'ai bien compris !
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa