Microsoft 365 Changement de titre du UserForm

Diane272727

XLDnaute Junior
Bonjour,
Je souhaite mettre à jour le titre de mon formulaire (en bleu, ou orange par exemple).
Sauriez vous comment le faire ?
Voici en PJ un fichier test.
Merci beaucoup et belle soirée
 

Pièces jointes

  • Couleur du titre du Userform.xlsm
    39.2 KB · Affichages: 8
Solution
Bonjour à tous
Hé oui sous XP il était possible de paramétrer les couleurs , la hauteur des barres de titre etc.. des userformes et des fenêtres.
Avec le progrès, tout cela a disparu :oops:
Vive le progrès🤬
il existe une astuce simple
qui de supprimer la barre de titre et de la substituer par ce que tu veux de la manière que tu veux
2 solutions
1° la plus simple
avec setwindowlong (superession de la caption
mettre un label(couleur back et text )que tu veux

2° et là c'est surtout sur W7 découpant le userform (l’intérieur) avec coin arrondi avec setwindowRgn et createroundrectRgn
et pareil label couleur et text que tu veux

et pour les deux appliquer l'api sendmessage sur ce label pour qu'il se comporte...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Toucher à ça c'est toucher aux paramètres système.

Les deux solutions proposées datent de 2006 et 2008, donc surement sous XP.
J'ai testé sous Win10 et effectivement c'est inopérant.

J'ai regardé sous ChatGPT pour voir, mais lui aussi donne des solutions inefficaces.
Je ne suis pas sur que sous Win10 on puisse modifier les paramètres système via VBA, peut être par sécurité.

Peut être une piste : https://forum.excel-pratique.com/excel/couleur-userform-172377
( j'ai joint le fichier en PJ )
L'astuce consiste à masquer la barre de titre et d'en créer une en "dessin"

1686661143382.png
 

Pièces jointes

  • usftitreperso.xlsm
    36 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
Hé oui sous XP il était possible de paramétrer les couleurs , la hauteur des barres de titre etc.. des userformes et des fenêtres.
Avec le progrès, tout cela a disparu :oops:
Vive le progrès🤬
il existe une astuce simple
qui de supprimer la barre de titre et de la substituer par ce que tu veux de la manière que tu veux
2 solutions
1° la plus simple
avec setwindowlong (superession de la caption
mettre un label(couleur back et text )que tu veux

2° et là c'est surtout sur W7 découpant le userform (l’intérieur) avec coin arrondi avec setwindowRgn et createroundrectRgn
et pareil label couleur et text que tu veux

et pour les deux appliquer l'api sendmessage sur ce label pour qu'il se comporte comme une barre de tire de userform(le drag)

démonstration
et là je la fais simple pas la peine de vous dire que l'on peut mettre une image
voilà mon userform
un label vide nommé "fausse caption" et un label nommé "fermer"
et la tu peux mettre les couleurs que tu veux la police que tu veux


1686696582045.png


attention ça va très vite hein
avec les coins arrondi 🥳
le tout mes dammes et messieux avec les api pilotées en macro4
pas de declaration d'api compatible Alls windows/Excel versions
pour 2021 activer les macro4 dans les option excel à moins qu'un puriste ai la bonté de vous le refaire avec api déclarées et avec le label mauve je drag bien le userform
demo.gif



le code
VB:
Option Explicit

Dim hwnd&

'sub de transformation
Private Sub Nocaption()
    Dim insideRect As Long, ptopx#, InsideTop#, InsideLeft#, InsidWidth#, InsidHeight#, insideMarge#, Arrondi&, CtrL
    Arrondi = 25
    With Me
        .faussecaption = .Caption
        .faussecaption.Width = .Width + 100
        .Height = Me.Height + 21
        .Top = .Top - 21
        For Each CtrL In .Controls
            If CtrL.Tag <> "XXX" Then CtrL.Top = CtrL.Top + 21
        Next
    End With

    With ActiveWindow.ActivePane: ptopx = (.PointsToScreenPixelsX(72 / (.Parent.Zoom / 100)) - .PointsToScreenPixelsX(0)) / 72: End With

    insideMarge = Round((Me.Width - Me.InsideWidth) * ptopx) - 1
    InsideLeft = Round(((Me.Width - Me.InsideWidth) / 2) * ptopx)
    InsideTop = Round((Me.Height - Me.InsideHeight) * ptopx) - (insideMarge - 2)
    InsidWidth = Round(Me.InsideWidth * ptopx) + InsideLeft
    InsidHeight = Round(Me.InsideHeight * ptopx) + InsideTop + insideMarge - 1
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow
    insideRect = ExecuteExcel4Macro("CALL(""gdi32"",""CreateRoundRectRgn"",""JJJJJJJ""," & InsideLeft & ", " & InsideTop & ", " & InsidWidth & ", " & InsidHeight & ", " & Arrondi & ", " & Arrondi & ")")
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowRgn"",""JJJJ""," & hwnd & ", " & insideRect & ", " & 1 & ")")
    ExecuteExcel4Macro ("CALL(""gdi32"",""DeleteObject"",""JJ""," & insideRect & ")")
End Sub


'bouton de transformation
Private Sub CommandButton1_Click()
    Nocaption
End Sub


'Drag le userform comme le fait la barre de titre d'origine
Private Sub faussecaption_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        ExecuteExcel4Macro "CALL(""user32"",""ReleaseCapture"",""JJJJJ"")"
        ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & hwnd & """,""" & &HA1 & """,""" & 2& & """,""0"")"
    End If
End Sub


Private Sub fermer_Click()
    Unload Me
End Sub

c'est pas mal le monde moderne non?;)
si vous voulez pas les angle arrondis mettez Arrondi à 0
demo.gif


fichier joint pour l'exemple
 

Pièces jointes

  • userform fausse caption.xlsm
    20.1 KB · Affichages: 5
Dernière édition:

Jacky67

XLDnaute Barbatruc
Hello Patrick
Heureusement tu as dit/écrit
il existe une astuce simple 😌
Joli travail mais........
Perso, je crois ne jamais utiliser cette astuce, et garder l'userform dans son format natif
Sur ce coup, je serais plutôt de l'avis de cp4
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonsoir @Jacky67

oui l'astuce est simple
mon code est un peu verbeux par ce que j'utilise les macro 4 sinon en écriture classique c'est simple
âpres c'est vrai il faut connaitre les api
là c'est du prémâché

en tout cas celui qui s'attaque à setsystemcolor sans en connaitre les conséquences est:
soit inconscient soit fou 🥳
 

Discussions similaires

Réponses
257
Affichages
6 K

Statistiques des forums

Discussions
314 629
Messages
2 111 351
Membres
111 111
dernier inscrit
houndemint