Discussion :

[Bana13]

Bonjour à toute la communauté,

Ca fait un bon bout de temps que je cherchais un moyen de créer les boutons REDUIRE et AGRANDIR/RESTAURER pour les userforms. Et par chance, je suis tombé sur un tutoriel qui traite du sujet. Mais à la base, les codes le codage est conçu et marche sous les versions 32 bits d'Excel. du coup, en farfouillant un peu sur Google, j'ai pu déboguer les erreurs de compatibilité en actualisant les "Declare Function". Du coup, plus aucune ligne n'est en rouge et pas de fenêtre de débogage au lancement du code. Mais mon soucis, c'est que ça ne marche pas. Le userform n'affiche aucune des boutons souhaités. Alors je suis un peu perdu parce que je ne m'y connais pas trop en VBA.

Voici le code d'origine qui marche dans le tutoriel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName 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 GetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVAl nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE As Long = (-18)
Private Const WS_THICKFRAME As Long = &H40000
Const MIN_BOX As Long = &H20000
Const Max_BOX As Long = &H10000
Private Declare Function DrawMenuBar Lib"user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetForegroundWindow Lib"user32.dll" () As Long
 
Public Sub AddToForm(ByVal Box_Type As Long)
Dim BisMask As Long
Dim Window_Handle As Long
Dim WindowStyle As Long
Dim Ret As Long
If Box_Type = MIN_BOX Or Box_Type = Max_BOX Then
    Window_Handle = GetForegroundWindow()
    WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
    BisMask = WindowStyle Or Box_Type
    Ret = SetWindowLong(Window_Handle, GWL_STYLE, BisMask)
    Ret = DrawMenuBAr(Window_Handle)
End If
End Sub
 
Private Sub Userform_Activate()
    Call AddToForm(MIN_BOX)
    Call AddToForm(Max_BOX)
End Sub
Sub resize()
    Dim hWndForm As Long
    Dim istyle As Long
    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", Me.Caption)
    Else
        hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    End If
    istyle = GetWindowLong(hWndForm, GWL_STYLE)
    istyle = istyle Or WS_THICKFRAME
    Call SetWindowLong(hWndForm, GWL_STYLE, istyle)
 
End Sub
Private Sub Userform_Initialize()
Call resize
End Sub

Voici mon code actualisé qui ne marche pas:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE As Long = (-18)
Private Const WS_THICKFRAME As Long = &H40000
Const MIN_BOX As Long = &H20000
Const Max_BOX As Long = &H10000
Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As Long
 
 
 
 
 
Public Sub AddToForm(ByVal Box_Type As Long)
Dim BisMask As Long
Dim Window_Handle As Long
Dim WindowStyle As Long
Dim Ret As LongPtr
If Box_Type = MIN_BOX Or Box_Type = Max_BOX Then
    Window_Handle = GetForegroundWindow()
    WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
    BisMask = WindowStyle Or Box_Type
    Ret = SetWindowLong(Window_Handle, GWL_STYLE, BisMask)
    Ret = DrawMenuBar(Window_Handle)
End If
End Sub
 
 
 
 
Private Sub Userform_Activate()
    Call AddToForm(MIN_BOX)
    Call AddToForm(Max_BOX)
End Sub
 
 
 
 
Sub resize()
    Dim hWndForm As Long
    Dim istyle As Long
    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", Me.Caption)
    Else
        hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    End If
    istyle = GetWindowLong(hWndForm, GWL_STYLE)
    istyle = istyle Or WS_THICKFRAME
    Call SetWindowLong(hWndForm, GWL_STYLE, istyle)
 
End Sub

Quelqu'un peut m'aider?

Cordialement!

[patricktoulon]

re
bonsoir
je te propose un raccourci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
#If win64 Then    '64 bits
    Private Declare PtrSafe Function FWD Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName As String) As Long
    Private Declare PtrSafe Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#Else
    '32 bits
    Private Declare Function FWD Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName As String) As Long
    Private Declare Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Private Sub UserForm_Activate()
Dim HANDLE1
HANDLE = FWD(vbNullString, Me.Caption)
SWL HANDLE, -16, &H94CF0080
End Sub

tu les a tes 3 bouton et en plus le redimentionnement avec la souris(elasticité) ainsi que le double clique et le snake etc.... tout comme une fentre normale


peut etre les conditions devront etre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
#if vba7 then 
'64
 
#else
'32
end if

[Bana13]

Bonjour PatrickToulon,

Ça alors, parlant de raccourci, c'est sacrément une bombe que vous m'avez donné! Ça marche comme du tonnerre
Merci beaucoup car ça me soulage énormément. Grand merci pour le coup! C'est tellement génial de finalement réussir à
créer ces boutons, tellement j'ai galéré des semaines en essayant.

Eh bien, pendant qu'on y est, vu que le Userform sera réduit dans la barre des tâches, je profite alors de l'occasion voir
s'il y a un code qui permet de changer l'icône Excel par une icône de mon choix, du genre un logo personnalisé qui apparait
dans une fenêtre au lancement de l'application et qui sera ensuite réduite dans la barre des tâches.

Merci d'avance!

Cordialement

[patricktoulon]

l'icone excel dans la barre des tache non mais dans la caption du userform oui

[patricktoulon]

exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
#If win64 Then    '64 bits
    Private Declare PtrSafe Function FWD Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName As String) As Long
    Private Declare PtrSafe Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare  PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As Longptr, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
    Private Declare  PtrSafe Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
#Else
    '32 bits
    Private Declare Function FWD Lib "user32" Alias "FindWindowA" (ByVal IpClassNAme As String, ByVal IpWindowName As String) As Long
    Private Declare Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
    Private Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
#End If
 
Private Sub CommandButton1_Click()
    Dim Fichier As String
    Dim x As Long
    Fichier = Application.GetOpenFilename("all (*.*), *.*") 'on choisi un exe ou un fichier".ico"
    x = ExtractIconA(0, Fichier, 0) 'on extarait l'icon du fichier
    SendMessageA FWD(vbNullString, Me.Caption), &H80, False, x 'on l'applique a la caption
End Sub
 
Private Sub UserForm_Activate()
    SWL FWD(vbNullString, Me.Caption), -16, &H94CF0080 'on met les 3 boutons
End Sub

résultat

[Bana13]

Rebonjour Patrick

Merci pour le code pour l’icône dans la caption. Ça ne résout pas totalement mon problème vu que je veux créer une application avec un interface qui
masque au mieux les attributs d'Excel.

Je laisse quand même la discussion ouverte au cas où quelqu'un aurait une idée. Merci beaucoup pour la réactivité et vous réponse spontanée.

Bien à vous!