Discussion :

[Ghost0000]

Bonjour,

Je dispose d'un code permettant de "griser" le bouton croix de fermeture en haut à droite d'un userform.

Cependant, lorsque j'exécute mon formulaire sur un ordinateur en 64 bits, cela m'indique une erreur de compatibilité.

L'idée serait de rendre compatible mon code qui marche sous 32bits sur ce type d'ordinateur en x64.

Pouvez-vous m'aider SVP ? car il s'agit d'une fonction système et je ne suis pas à l'aise !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'Fonctions systèmes nécessaires à la désactivation du bouton "Croix de fermeture" de Mise_en_Forme
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
 
Private Declare Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function RemoveMenu Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

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
Private Sub CommandButton4_Click()
'Bouton "Formulaire" permettant d'afficher le formulaire
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'Masquer le bouton "Croix de fermeture"
Dim hSysMenu As Long
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Modification.Caption)
    If MeHwnd > 0 Then
        hSysMenu = GetSystemMenu(MeHwnd, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Modification.Caption & " Introuvable", vbCritical
    End If
 
'Affichage du formulaire "Modification"
Formulaire.Hide
Modification.Show 0
End Sub

Merci d'avance de votre aide !!

GK

[Marc-L]

Bonjour, bonjour !

Consulter le tutoriel Développer avec Office 64 bits …

Voilà, voilà !


______________________________________________________________________________________________________
Je suis Paris, Charlie, …

[Ghost0000]

C'est ça qui faut que je mette ??

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'Déclaration de l'API
#If VBA7 Then
Private Declare PtrSafe Sub PathStripPath Lib "shlwapi.dll" _
   Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
   Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
Private Declare Sub PathStripPath Lib "shlwapi.dll" _
   Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
   Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If

[Ghost0000]

J'ai fait ça pour le moment, je vais tester sur un ordinateur en x64 d'ici demain :

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
'Fonctions systèmes nécessaires à la désactivation du bouton "Croix de fermeture" de Mise_en_Forme
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
 
#If VBA7 Then 'Version x64
Private Declare PtrSafe Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare PtrSafe Function RemoveMenu Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
Private Declare PtrSafe Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else         'Version x86 (32 bits)
Private Declare Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function RemoveMenu Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Je me demande s'il faut que je modifie ce code par la même occasion ? (qui se trouve au sein d'un bouton)

Code :

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

1
2
3
4
5
6
7
8
9
10
'Masquer le bouton "Croix de fermeture"
Dim hSysMenu As Long
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Modification.Caption)
    If MeHwnd > 0 Then
        hSysMenu = GetSystemMenu(MeHwnd, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Modification.Caption & " Introuvable", vbCritical
    End If

[Ghost0000]

J'ai trouvé mon bonheur ici : http://www.jkp-ads.com/articles/apideclarations.asp

On y retrouve la majorité des déclarations de l'API en x64 et x86(32 bits).

Après mes tests, je posterai ici même la version définitive et fonctionnelle du code.

[Ghost0000]

Voici la solution (testé et fonctionnelle):

Pour résumer :
1- Il faut modifier uniquement le code de déclaration des variables de l'API.
2- Le code faisant appel à ces variables reste inchangé.
3- Pour passer de x86 (32bits) à x64, il faut simplement :
-a Rajouter "Ptrsafe" entre "Declare" et "Function"
-b Passer les "Long" en "Longptr"

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
'Fonctions systèmes nécessaires à la désactivation du bouton "Croix de fermeture" de Mise_en_Forme
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
 
#If VBA7 Then 'Version x64
Private Declare PtrSafe Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As LongPtr, ByVal bRevert As LongPtr) As LongPtr
 
Private Declare PtrSafe Function RemoveMenu Lib "user32" _
        (ByVal hMenu As LongPtr, ByVal nPosition As LongPtr, ByVal wFlags As LongPtr) As LongPtr
 
Private Declare PtrSafe Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else         'Version x86 (32 bits)
Private Declare Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function RemoveMenu Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Cordialement.

GK