Combiné deux fonction dans un userform

Version imprimable

ien le bonjour,
Vola j'ai deux fonctions (qui ne sont pas de moi) que je voudrai mettre sur un UserFom
La première pour mettre un icone sur la barre de titre
La seconde pour ôter la croix pour fermer l'UserForm

Le problème est quand je met la seconde ça masque l'icone de la première donc je voudrai quelqu'un pour m'aider à mettre ces deux fonctions sur mon UserForm.

Code:

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
 
Option Explicit
'#Function pour ajouter un icone a la barre de titre
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" _
      (ByVal hwnd As Long, 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
'#Fin Function pour ajouter un icone a la barre de titre
'#Function pour masquer la croix
Private Declare PtrSafe Function GetWindowLongA Lib "user32" _
    (ByVal hwndd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" _
    (ByVal hwndd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'#Fin de la function masquer la croix
 
 
'#Fin#
Private Sub UserForm_Initialize()
    Dim Fichier As String
    Dim x As Long
    OteCroix Me.Caption
    'Chemin et nom du fichier icône à afficher
    Fichier = "C:\Camping\IconeApp.ICO"
    'Vérifie si le fichier existe
    If Dir(Fichier) = "" Then Exit Sub
 
    x = ExtractIconA(0, Fichier, 0)
    SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, x
 
End Sub
 
'#Sub#
Private Sub OteCroix(Caption As String)
Dim hwnd As Long
   hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Merci a vous ;)

03/07/2017, 00h43
mercatog

Par hasard

Ôte la croix en premier ensuite ajoute l’icône
03/07/2017, 12h03
chrisl0

bonjour,

Non ça fonctionne pas j'ai déjà essayer et sa ne me met pas l'icone mais sa me cache bien la croix.
J'arrive pas a combiner les deux.

Autrement (Adapte PtrSafe)

Ajoute l'icône et désactive la croix

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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
 
Private Sub UserForm_Initialize()
Dim Fichier As String
 
Fichier = "C:\Users\hp\Desktop\Suppeda.ico"
If Dir(Fichier) <> "" Then SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, ExtractIconA(0, Fichier, 0)
 
'désactive la croix
RemoveMenu GetSystemMenu(FindWindow(vbNullString, Me.Caption), False), &HF060&, &H0&
End Sub

Sinon, Si pour empêcher la fermeture par la croix et sans api, utiliser l'évènement QueryClose

Code:

1
2
3
4
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 
If CloseMode = 0 Then Cancel = True
End Sub

03/07/2017, 16h24
chrisl0

merci pour ta réponse.

Alors pour "Ptrsafe" je suis obliger car je suis sous excel 2016 sinon les function ne fonctionne pas.

et pour le queryclose oui je pense faire comme ça, sa sera plu simple je pense encore merci a toi ;)
03/07/2017, 20h52
clementmarcotte

Citation:

Envoyé par chrisl0

merci pour ta réponse.

Alors pour "Ptrsafe" je suis obliger car je suis sous excel 2016 sinon les function ne fonctionne pas.

Cela n'a aucun rapport. Tu peux avoir besoin de Ptrsafe avec n'importe quelle version d'Office depuis Office 2010. Tu as besoin de PtrSafe avec un Office à 64 bits.