XL 2013 Icône d'aide dans la barre de titre d'un Userform

[Achille_1]

Bonjour à tous,

Je souhaiterais mettre une icône d'aide (un point d'interrogation, un peu comme excel) pour ouvrir un userform contenant une aide.
Comme sur l'image ci-dessous.

Est-ce possible ?

Achille

 

[sylvanu]

Bonjour Achille,
Je ne connais aucune solution. Attendez des réponses plus pertinentes.

Mais en désespoir de cause si vous ne trouvez rien, un gros ? bien visible en haut à gauche provoquera la même réaction chez l'utilisateur que s'il était dans la barre. Et c'est très simple à gérer.

 

[Staple1600]

Bonsoir le fil, Achille_1, silvanu

Une piste à creuser
(en attendant que "le gars de Toulon" (il se reconnaîtra ) passe dans le fil)

#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

 

[patricktoulon]

le shell de la user32 ne délivre que 3 boutons les autres application ayant des fenêtres avec bouton ? ou print et je ne sais quoi d'autre utilise un patch dérivé et ou basé sur le uxthemes bien connu des xptoman
il te faudrait donc une de ces dll et qu'elle puisse surtout être pilotée par vba
il y a peut être une autre solution
se serait de garder le cadre avec les coins ronds et créer une pseudo caption en haut de l'userform

un peu comme ceci
je te laisse adapter les api pour 64 moi ca me saoule

'patricktoulon exceldownload

#If vba7 Then





    Dim handle As longptr
#Else
    'trouver le handle
    Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
    Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    'application des modification
    Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim handle
#End If
Private Sub Label1_Click()
    Unload Me
End Sub

Private Sub Label2_Click()
    With Label1
        If .Tag <> "3" Then .Tag = "3" Else .Tag = "1"
        handle = fwa(vbNullString, Me.Caption)
        showw handle, Val(.Tag)
    End With
End Sub

Private Sub Label3_Click()
    handle = fwa(vbNullString, Me.Caption)
    showw handle, 2
    End Sub

Private Sub UserForm_Activate()
    handle = fwa(vbNullString, Me.Caption)
    SetWindowLongA handle, -16, &H140F0101                      ' sans caption cadre epais coin  arrondi et elastique
    DrawMenuBar handle
End Sub



Private Sub UserForm_Resize()
    Frame1.Width = Me.Width
    For Each ctrl In Me.Frame1.Controls
        i = i + 1
        l = l + ctrl.Width
        ctrl.Left = Frame1.Width - l - 10 - (i * 2)
    Next
End Sub

qu'est ce qu'on s'amuse

 

[Staple1600]

Bonsoir patricktoulon

Même pas un petit merci pour avoir fait ta pub
(cf message#3)

 

[patricktoulon]

bonsoir Staple1600
je me disais bien aussi ,je reconnais mon style et mes abréviation de nom d'api
merci

je me rappelle de cette erreur aussi dim handle1

mais dans l'exemple que je propose je fais justement péter la caption

 

[Achille_1]

Bonjour sylvanu, staple1600 et patricktoulon,
et merci de vos réponses !
je suis en train de tester ton exemple patrick, mais j'ai un petit soucis de mon côté..
J'ai le droit à une petite erreur :

Achille

 

[patricktoulon]

a tu comme je te l'ai dis adapter en 64
il faut pas lire en diagonale sinon on s'en sort pas
je garanti rien je ne code pas en 64

#If vba7 Then
 'trouver le handle
    Private Declare ptrsafe  Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Longptr
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare ptrsafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Longptr) As Long
    'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
    Private Declare ptrsafe Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Longptr, ByVal nCmdShow As Long) As Long
    'application des modification
    Private Declare ptrsafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Longptr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim handle As Longptr
#Else
    'trouver le handle
    Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
    Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    'application des modification
    Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim handle As Long
#End If

 

[Achille_1]

Le problème c'est que je suis aussi en 32

 

[Eric C]

Bonjour le forum
Bonjour Achille, Sylvanu, Staple et Patrick

@patrick ( ). Comme aurait dit Maître Capello voire Staple (), je plussoie à la réponse de Achille. Je suis en 32bits et l'erreur évoquée m'est également générée.
Bonne journée à toutes & à tous

 

[Achille_1]

Bonjour Eric,
Je pense, sauf erreur de ma part que tu n'as pas tag le bon patrick @patricktoulon

Bonne journée à toi aussi

 

[patricktoulon]

re
en 2007 32 bits

 

[patricktoulon]

rer
j'ai enlever les alias pour etre sur

'patricktoulon exceldownload

#If vba7 Then
'trouver le handle
    Private Declare ptrsafe  Function FindWindowA Lib "user32"  (ByVal lpClassName As String, ByVal lpWindowName As String) As Longptr
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare ptrsafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Longptr) As Long
    'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
    Private Declare ptrsafe Function "ShowWindow" Lib "user32"  (ByVal hwnd As Longptr, ByVal nCmdShow As Long) As Long
    'application des modification
    Private Declare ptrsafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Longptr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim handle As Longptr
#Else
    'trouver le handle
    Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    'application des modification
    Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim handle As Long
#End If
Private Sub Label1_Click()
    Unload Me
End Sub

Private Sub Label2_Click()
    With Label1
        If .Tag <> "3" Then .Tag = "3" Else .Tag = "1"
        handle = FindWindowA(vbNullString, Me.Caption)
        ShowWindow handle, Val(.Tag)
    End With
End Sub

Private Sub Label3_Click()
    handle = FindWindowA(vbNullString, Me.Caption)
    showw handle, 2
    End Sub

Private Sub UserForm_Activate()
    handle = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA handle, -16, &H140F0101    ' sans caption cadre epais coin  arrondi et elastique
    DrawMenuBar handle
End Sub



Private Sub UserForm_Resize()
    Frame1.Width = Me.Width
    For Each ctrl In Me.Frame1.Controls
        i = i + 1
        l = l + ctrl.Width
        ctrl.Left = Frame1.Width - l - 10 - (i * 2)
    Next
End Sub

faut il encore que la frame1 y soit avec des bouton (label) a l'interieur
j'en ai même rajouter

si ca fonctionne pas c'est que soit
vous avez un soucis avec les api
soit que vous etes en 64 car les déclarations api en 64 je ne les garantie pas( je repete je ne code pas en 64)

 

[Achille_1]

Ok, ça marche à peu près comme toi de mon côté maintenant.
Je n'ai pas les coins ronds mais ça doit être parce qu'on n'a pas la même version d'excel je suppose.
Je vais continuer à creuser et à exploiter ton code, merci encore !

Achille

 

[patricktoulon]

re
Hah!!!
a la bonne heure!!
Ok tu est sur Windows 10 et excel 2016 ou 2019 et donc les alias pour api ben.... walouh walouh tout simplement ( je m'en doutais j'ai déjà constaté le problème )
les coins ronds c'est normal que tu ne les ai pas l'affichage d'origine avec W10 c'est coins carré car l'api setwindowlongA fait en fonction du shell de la user32 du system
il n'y a que avec 2007 et W7 que les coins sont arrondis

mais bon tu a le redim de la fentre userform par les angles et cotés et tu a les 3 boutons de substitution des fenêtreq normales
tu peux ajouter autant de boutons que tu veux
Enjoy