XL 2016 UserForm titre : centrer le texte et le formater

[Usine à gaz]

Bonjour à toutes et à tous,

Je voudrais dans mon UserForm centrer le texte et le formater (par exemple : Arial -11- gras)

J'ai trouvé dans le forum un post de 2004 :

Comment centrer un texte dans un userform

Bonjour à tous, je voulais savoir s'il est possible de centrer un texte dans la barre de titre d'un userform. C'est possible d'utiliser le curseur mais ce n'est aps tres commode merci de votre aide

www.excel-downloads.com

où Eric C donne une solution "UNE des RUSES de LaurentTBT" que j'ai copié dans le fichier test joint.
Je n'arrive pas à la faire fonctionner.

Pourriez-vous m'apporter votre technicité ?

Un grand merci à toutes et à tous,
Je vous souhaite un très beau WE,
Amicalement,
lionel,

 

[Usine à gaz]

Merci à toi pour ce code
OUI, je voudrais UserForm titre : centrer le texte et le formater
J'ai inséré ton code mais j'ai du me tromper car ça ne fonctionne pas :

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type POINTAPI: X As Long: Y As Long: End Type
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type

Dim mois_courant
Dim témoin, Début, Fin
Private Sub B_valid_Click()
 ActiveCell.Value = CDate(Me.Date_début & " " & Me.ComboBox1)
 Unload Me
End Sub

Private Sub label1_Click()
End Sub

Private Sub LbAujourdhui_Click()
End Sub

Private Sub UserForm_Activate()
Call UserformPosSurCell(Me, ActiveCell)
If DatTag > Date Then LbAujourdhui.Enabled = False 'accès bouton date aujourd'hui!?
End Sub

Private Sub ComboBox1_Change()
ActiveCell.Value = CDate(Me.Date_début & " " & Me.ComboBox1)
    If ActiveCell < 10000 Then
    jrs_heures.Show
    ActiveCell = ""
    Else
    Unload Me
    End If
End Sub

Private Sub Label3_Click()
End Sub

'croix inactive
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = CloseMode = 0
End Sub

Private Sub UserForm_Initialize()
  Dim hdc&, TextSize As POINTAPI, Cx&, R As RECT
    hdc = GetDC(FindWindow(vbNullString, Me.Caption)): GetWindowRect hwnd, R
    GetTextExtentPoint32 hdc, Me.Caption, Len(Me.Caption), TextSize
    Cx = (R.Right + R.Left + TextSize.X) / 2
    Do While TextSize.X < Cx
    Me.Caption = " " & Me.Caption
    GetTextExtentPoint32 hdc, Me.Caption, Len(Me.Caption), TextSize
    Loop
    
  LbAujourdhui.Caption = Format(Date, "dddd dd mm yyyy") 'date bouton aujourd'hui
'  LbNoSem1 = "": LbNoSem2 = "": LbNoSem3 = "": LbNoSem4 = "": LbNoSem5 = "": LbNoSem6 = ""
  Dim décal
  affiche_calendrier (Date)
  mois_courant = Date
  décal = Weekday(DateSerial(Year(mois_courant), Month(mois_courant), 1), vbMonday) - 1
  For i = 16 To 40
    Me.ComboBox1.AddItem Format(i / 48, "hh:mm")
  Next i
End Sub

Je me suis trompé ?

 

[patricktoulon]

re
si tu es en 64 bits il te faut modifier les déclarations d'api pour 64 tes déclarations sont pas bonnes
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function GetDC Lib "USER32" (ByVal HWnd As LongPtr) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
etc...

 

[Usine à gaz]

Je suis sur Office 2016 en 32 bits

 

[patricktoulon]

re
t'inquiet eric moi aussi je suis un bidouilleur

 

[patricktoulon]

ok et a tu une erreur
si oui sur quelle ligne

 

[patricktoulon]

deja ici
pas ceci
hdc = GetDC(FindWindow(vbNullString, Me.Caption)): GetWindowRect hwnd, R

mais cela (c'est moi qui avais fait l'erreur j'ai corrigé après mais tu l'avais déjà pris)
hdc = GetDC(FindWindow(vbNullString, Me.Caption)): GetWindowRect FindWindow(vbNullString, Me.Caption), R

 

[Usine à gaz]

NON pas d'erreur mais le texte du titre de l'UF reste à gauche.
le code ne semble pas agir.

 

[Usine à gaz]

J'ai remplacé :
hdc = GetDC(FindWindow(vbNullString, Me.Caption)): GetWindowRect hwnd, R
par :
hdc = GetDC(FindWindow(vbNullString, Me.Caption)): GetWindowRect FindWindow(vbNullString, Me.Caption), R
mais c'est pareil

 

[Eric C]

@patricktoulon

Oui mais un bon & gros (ce n'est pas péjoratif) bidouilleur qui sait et connait où il va.

 

[Eric C]

@ arthour973
Idem pour moi, le code ne semble pas réactif.

 

[patricktoulon]

fait tes test dans un fichier neuf avec juste le userform
tu integrera apres test reussi

 

[Eric C]

RE;

Redémarrage EXCEL 2007 et toujours le USF dans sa partie gauche ??
Bon dimanche à toutes & à tous

 

[ChTi160]

Bonjour arthour973
Bonjour le Fil (Patrick),le Forum
chez moi rien ne se passe , pas même un message d'erreur !(W32 -Office 2010) Lol
j'ai juste du déclarer "hwnd"(Long) dans UserForm_Initialize
Merci
Bonne journée
jean marie

 

[Usine à gaz]

Bonjour du dimanche matin à toutes et à tous

Des fois que la nuit lui aurait porté conseil (à mon fichier LOL), je l'ai à nouveau ouvert ce matin pour voir (si miracle).
Ben non ça ne bouge pas d'un poil le texte du titre de l'UF est toujours à gauche.
Fichier en pièce jointe.
Bon dimanche à toutes et à tous,
lionel,

 

[patricktoulon]

re
bonjour bon dimanche
ouais ma fois il me semble que tu m'a dis être en 2016 32 bits
alors perso je vois pas ce que viennent faire des déclarations 64 ptrsafe
et par pitié comme je te l'ai dit teste sur un fichier vierge avec un Userform et c'est tout ,tu intégrera après