XL 2016 UserForm titre : centrer le texte et le formater

arthour973

XLDnaute Barbatruc
Supporter XLD
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 :
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,
 

Fichiers joints

Eric C

XLDnaute Accro
Bonjour le forum
Bonjour arthour973

Tu n'as pas respecté toutes les consignes éditées ... car cela fonctionne.
Bon week-end à toutes & à tous
 

Eric C

XLDnaute Accro
Oupsss.... Pas encore l'habitude de toutes ces fonctionnalités :
VB:
WordWrap à False, Autosize à true et enfin, je le masque (visible=false).
@+ Eric c
 

arthour973

XLDnaute Barbatruc
Supporter XLD
Re-Bonjour Eric C, toutes et tous,

En fait, le code affiche le texte de la Feuil1 et le centre effectivement.
Mais il perd sa propriété d'affichage du mois affiché :
990847-5074e900c88b80129d24a948084239b2.jpg

On ne sait plus vraiment sur quel mois on est LOL :)
 
Dernière édition:

Eric C

XLDnaute Accro
Re,

J'ai fait un petit tour sur le net, histoire de.... et j'ai trouvé ce code adapté par NEC14 d'un site également et entre autres, dédié à EXCEL : https://www.developpez.net/forums/d1311861/logiciels/microsoft-office/excel/macros-vba-excel/changer-police-titre-d-uf/ - Tiens mes attributs de la barre d'édition sont grisés ????? - Bon, après essais (non concluants), il s'agit comme le dit son adaptateur, d'une véritable usine à gaz qui aurait tendance à planter le prog... A éviter
Bonne soirée
@+ Eric c
 

arthour973

XLDnaute Barbatruc
Supporter XLD
Re Eric C,

Merci d'avoir cherché.
J'y suis allé aussi et c'est vraiment pas top LOl.
J'ai également fait d'autres recherches sans résultat.

Dans mon cas, cela concerne un calendrier qui affiche dans le titre de l'UserForm le mois sur lequel on est.
(Me.Caption = "mois affiché : " & Format(Dt, "mmmm yyyy"))
c'est ce titre que je voudrais pouvoir modifier.
photo.jpg

Apparemment ce n'est pas possible :mad:

Cela m'étonne car Excel es tellement "paramétrable" qu'il doit bien y avoir une solution !
Mais tant pis LOL

Bonne fin de journée :)
lionel,
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
re
bonsoir a tous
le coup du label c'est bien pour dimensionner des object a l’intérieur de l'userform

mais pour la caption vous semblez oublier que ce que vous voyez a l’écran n'est pas forcement ce qui est surtout avec aero W7 ou le thème principal de W10
vous êtes loin du compte
il n y a que dans XP que les dimensions sont respectées toutes les autres version après walouhhh!!!sauf w7 starter(pas d'aero) ou le thème classic de W7


constatez
VB:
Private Sub UserForm_Activate()
Me.Width = ActiveSheet.Shapes("caré").Width
Me.Height = ActiveSheet.Shapes("caré").Height
End Sub
l'userform est sensé être de même dimension que le shape

demo3.gif

essayez maintenant ceci:
Code:
Private Sub UserForm_Activate()
With Me
.Width = ActiveSheet.Shapes("caré").Width - ((.Width - Me.InsideWidth) * 2)
Me.Height = ActiveSheet.Shapes("caré").Height - ((.Width - Me.InsideWidth) * 2)
End With
End Sub
après cela il vous faut enlever la dimension du bouton
pour info voila le résultat que j'ai avec votre fichier
Capture.JPG
conclusion la ruse ben je sais pas ou elle est tant que vous ne merceriserez pas la différence entre les vrai dimensions et ce qui s'affiche a l’écran

pour info tout object ayant un handle(non commun)(fenetre,listbox,listview,frame)pour son affichage est manipulé par le shell32.dll qui applique son thème Windows et tout ce qui en découle
;)

je ne vais même pas vous parlez de la différence entre la lecture d'un width et l'application qui est aussi différente
exemple je vous ai montrer comment obtenir les dim en point correspondant a ceux d'un shape

mettons en application dans votre contexte
on constate qu'en lecture du width je me sert de height et insideheight pour les soustraction alors q'en application plus haut c’était width et insidewidth
Code:
Private Sub UserForm_Activate()
    Dim Espaces As Byte
    Me.label1 = Worksheets("Feuil1").Range("B3")
    Do Until Me.label1.Width >= Me.Width - ((Me.Height - Me.InsideHeight) * 2)
        Me.label1 = " " & Me.label1 & " "
        Espaces = Espaces + 1
    Loop
    Me.Caption = Mid(Me.label1, 2, Len(Me.label1) - Espaces)
End Sub
Capture.JPG
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
tu veux centrer ton texte de caption??

sert toi des api

VB:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare 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 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


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
End Sub
 

Eric C

XLDnaute Accro
Re,
Bonsoir patricktoulon,

Pour ma part, je ne suis qu'un utilisateur lambda d'EXCEL qui a bidouillé en VBA (il y a fort longtemps... Par ailleurs, j'ai oublié tout ce qui pouvait m'être utile... ainsi va la vie). Je repasse sur le forum pour tenter d'apporter un tout petit peu d'assistance avec mon vécu... (ET mes archives) et c'est tout. A part bricoler les codes, je ne connais pas les fonctions, les formules et tout ce qui vous passionnent, vous les Grands de ce forum (et des autres aussi). MERCI encore de nous apporter votre savoir et vos connaissances.
@+ Eric c
 

arthour973

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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

XLDnaute Impliqué
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...
 

Discussions similaires


Haut Bas