XL 2013 Fonction pour déterminer la largeur en points ou pixels d'un texte

Dudu2

XLDnaute Barbatruc
Bonjour,

Petit souci avec un Label dans un UserForm qui est en AutoSize = True mais qui ne s'ajuste qu'en hauteur.
Il semble qu'il s'ajuste en largeur sur les 6 ou 7 premiers caractères.

D'où la question: existe-t-il une fonction pour déterminer la largeur en points ou pixels d'un texte sans retour à la ligne, même approximative ?'

Sinon je vais essayer d'exploiter cette largeur par défaut en considérant simplement qu'elle contient 6 caractères représentatifs d'un texte quelconque et appliquer le ratio sur la longueur du texte.


Merci par avance pour toute suggestion.
 

Pièces jointes

  • Classeur1.xlsm
    19.6 KB · Affichages: 17
Dernière édition:
Solution
Re (et un salut à Staple1600)

Je ne t'avais pas oublié, mais avais une occupation prioritaire (promenade de mon épouse au soleil)
Regarde ce que fait ceci :
- un userform avec un bouton de commande commandbutton1
- un label label1 placé où tu veux et avec les dimensions que tu veuxavec ces propriétés (toutes les 3) :
Visible = False
AutoSize = True
WordWrap = False

et ce code :

VB:
Private Type dimens
  largeur As Single
  hauteur As Single
End Type

Private Type FLICS
  bname As String
  bbold As Boolean
  bitalic As Boolean
  bsize As Integer
End Type
Private Sub CommandButton1_Click()
  Dim mon_flic  As FLICS, texte As String
  With mon_flic
   .bname = "Tahoma"
   .bitalic = True...

jmfmarques

XLDnaute Accro
Bonjour Dudu2
Non : aucune fonction VBA/Excel pour ce faire.
La chose est certes réalisable mais a un coût non négligeable : celui de l'utilisation de plusieurs fonctions de l'Api de Windows. C'est lourd et je te le déconseille.
Une astuce, alors, pour déterminer les dimensions graphiques d'un texte ? --->>> oui, bien sûr : elle consiste à utiliser un label masqué utilisant la même police de caractères et à la même taille de police, de donner à sa propriété caption la valeur du texte dont on veut connaître les dimensions graphiques, puis de constater ses propres dimensions avec sa propriété Autosize = True.
Je veux bien t'en faire un exemple, mais à condition que ce ne soit pas pour un "coup de glaive dans l'océan". Il se trouve que cela en serait un si ta démarche avait pour but celui de déterminer les dimensions à donner à une cellule Excel, Excel gérant son affichage d'une manière assez "particulière" rendant alors la chose très "improbale", sinon carrément impossible.
 

Dudu2

XLDnaute Barbatruc
Bonjour jmfmarques,

J'ai mis au point un MsgBoxPerso et un InputBoxPerso sur la base d'un UserForm ce qui est moins aisé qu'on pourrait le penser de prime abord, mais je crois que j'y suis bien.

La seule chose qui me manque c'est l'ajustement automatique du Prompt au plus juste du texte qui le compose. Pour l'instant j'ai simplement défini un ajustement basé sur la largeur incluant les boutons et une largeur minimale, et la possibilité par argument de fonction de la redéfinir / forcer.

Tu parles d'un Label masqué en AutoSize = True.
Mais c'est précisément ce que j'ai illustré dans ma question... Il ne s'ajuste qu'en hauteur, pas en largeur. Tu as une solution pour que la largeur suive ?
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Dudu62, jmfmarques

Suggestion:
Utilises un TextBox déguisé en Label ;)
VB:
Private Sub UserForm_Activate()
Randomize 1600
TextBox1.AutoSize = True
TextBox1.SpecialEffect = fmSpecialEffectFlat
TextBox1.BackStyle = fmBackStyleOpaque
With Application
TextBox1 = .Rept(Chr(.RandBetween(65, 90)), .RandBetween(1, 20))
End With
End Sub
A tester avec sur un userform contenant un TextBox1
(Et pour tester afficher l'userform N fois)
NB: La syntaxe .Rept ... (ne sert que pour le test)
 

Dudu2

XLDnaute Barbatruc
Merci Staple1600 pour cette suggestion.

En gardant le MultiLine = False, on obtient effectivement la largeur effective du texte valorisé.
Avec un MultiLine = True, on retombe dans l'écueil du Label avec un AutoSize = True qui ne s'applique qu'à la hauteur.

Je vais faire des essais dans ce sens, en utilisant une "fake" TextBox utile pour dimensionner la ligne la plus longue d'un texte en considérant toutefois un maximum de largeur pour rester dans les clous.
Puis j'appliquerai cette dimension au Label.

Merci pour vos contributions.
 

jmfmarques

XLDnaute Accro
Re (et un salut à Staple1600)

Je ne t'avais pas oublié, mais avais une occupation prioritaire (promenade de mon épouse au soleil)
Regarde ce que fait ceci :
- un userform avec un bouton de commande commandbutton1
- un label label1 placé où tu veux et avec les dimensions que tu veuxavec ces propriétés (toutes les 3) :
Visible = False
AutoSize = True
WordWrap = False

et ce code :

VB:
Private Type dimens
  largeur As Single
  hauteur As Single
End Type

Private Type FLICS
  bname As String
  bbold As Boolean
  bitalic As Boolean
  bsize As Integer
End Type
Private Sub CommandButton1_Click()
  Dim mon_flic  As FLICS, texte As String
  With mon_flic
   .bname = "Tahoma"
   .bitalic = True
   .bbold = True
   .bsize = 14
  End With
  texte = "coucou et re coucou " & vbCrLf & " voilà"
  MsgBox "ton texte " & texte & " a les dimensions graphiques suivantes " & vbCrLf & _
  "largeur : " & DIM_GRAPH(texte, mon_flic).largeur & vbCrLf & "hauteur : " & DIM_GRAPH(texte, mon_flic).hauteur
End Sub

Private Function DIM_GRAPH(ch As String, p As FLICS) As dimens
  With Label1
    .Caption = ch
     With .Font
      .Name = p.bname
      .Size = p.bsize
      .Bold = p.bbold
      .Italic = p.bitalic
     End With
     DIM_GRAPH.largeur = .Width
     DIM_GRAPH.hauteur = .Height
   End With
End Function
Fais varier comme tu l'entends le texte (et sa police) dont tu veux connaître les deux dimensions graphique et regarde.

Je t'ai "développé" le truc, que tu pourras simplifier ensuite à ta guise en fonction de ton seul besoin, après en avoir bien compris la moelle
 

Dudu2

XLDnaute Barbatruc
Dans un premier temps j'ai utilisé la méthode de Staple1600 en utilisant une TextBox temporaire non visible.
Une petite subtilité concernant le dimensionnement du Label dans la séquence des settings:
  1. Label.AutoSize = False
    AVANT d'avoir déterminé la Width, Sinon la hauteur s'ajuste à la Width par défaut et ne se corrigera plus par la suite.
  2. Valoriser Label.Caption
  3. Valoriser Label.Width
  4. Label.AutoSize = True
    APRÉS avoir déterminé la Width, pour que la hauteur s'ajuste en fonction de la Width définie
Toute autre séquence n'aboutit pas au résultat !

Maintenant je vais essayer la méthode de jmfmarques.
 

Pièces jointes

  • Label Width basée sur une TextBox temporaire.xlsm
    25.1 KB · Affichages: 11
Dernière édition:

Dudu2

XLDnaute Barbatruc
Le tour du monde, pour 1 paramètre !

Les fonctions de jmfmarques montrent qu'en fait, pour que le Label prenne la bonne largeur, outre le fait qu'elles permettent de connaitre les dimensions d'un texte en points dans un Control ce qui répond à la question initiale, il faut 2 settings d'une simplicité déconcertante:
- Label.AutoSize = True (ok ça on savait !)
- WordWrap = False (celui-là change tout et je ne savais pas !)
Et on obtient la même chose qu'avec l'usine à gaz que j'ai codée juste avant.
Ben voilà :oops:
Merci à tous les 2 pour votre support dans ces investigations.
 

Pièces jointes

  • Label Width WordWrap False.xlsm
    21.3 KB · Affichages: 14

Modeste geedee

XLDnaute Barbatruc
Bonsour®une autre proposition :
avec "usine à gaz" expliquée
© Laurent Longre 1999-2013
Tous droits de reproduction réservés


Dimensions de texte formaté en pixels


La fonction DimTexte(Texte, Police, Taille[, Gras][,Italique]) suivante renvoie la largeur et la hauteur en pixels d'un texte en fonction de son format (contenu de la chaîne de caractères, nom de la police, taille de la police, attributs gras et / ou italique).
La valeur renvoyée par cette fonction est une structure de type SDimTexte incluant deux champs, "Largeur" et "Hauteur".
Par exemple, le code suivant affiche les dimensions en pixels du texte contenu dans la cellule active :
VB:
Dim TailleTexteCell As SDimTexte
With ActiveCell.Font
TailleTexteCell = DimTexte(.Parent.Text, _
.Name, .Size, .Bold, .Italic)
End With
With TailleTexteCell
MsgBox "Largeur du texte de la cellule active : " & .Largeur _
& " pixels, hauteur : " & .Hauteur & " pixels."
End With
Les arguments Texte, Police et Taille sont obligatoires.
Les arguments optionnels Gras et Italique sont égaux par défaut à False (caractères non gras, non italiques).
La procédure de test ci-dessous utilise la fonction DimTexte pour ajuster la taille d'un contrôle CommandBarComboBox de type msoControlDropdown (liste déroulante non modifiable) placé sur une barre d'outils à la largeur en pixels de son élément le plus long.
Ce contrôle ne disposant d'aucune propriété "AutoSize", le recours aux fonctions API est ici nécessaire pour obtenir cet ajustement avec une précision acceptable.
VB:
Type SDimTexte
Largeur As Long
Hauteur As Long
End Type

Private Declare Function GetDC Lib "User32" _
(ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "User32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Declare Function CreateFontA Lib "Gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long


Private Declare Function SelectObject Lib "Gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function GetTextExtentPoint32A Lib "Gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As SDimTexte) As Long

Private Declare Function GetDeviceCaps Lib "Gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

'____________________________________________________________

Private Function DimTexte(Texte As String, Police As String, _
Taille As Double, Optional Gras As Boolean, _
Optional Italique As Boolean) As SDimTexte

Dim hFont As Long, hDC As Long
Dim PixpInch As Double

hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 - 300 * Gras, -Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then
ReleaseDC 0, hDC
DimTexte.Largeur = 0
DimTexte.Hauteur = 0
Else
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), DimTexte
DeleteObject hFont
ReleaseDC 0, hDC
End If

End Function

'____________________________________________________________

Sub Test()

' Création d'un contrôle DropDown sur une barre d'outils
' avec ajustement automatique sur la largeur de l'élément
' le plus long
VB:
Dim Ctrl As CommandBarComboBox, Elt
Dim TempL As Integer, LargeurMax As Integer

' Création d'une nouvelle barre d'outils
On Error Resume Next
Application.CommandBars("Zaza").Delete
On Error GoTo 0
Application.CommandBars.Add("Zaza").Visible = True

' Création du contrôle et recherche du texte le plus long
Set Ctrl = Application.CommandBars("Zaza") _
.Controls.Add(msoControlDropdown)

For Each Elt In Array("Arm", "Stram", "Gram", _
"Pic et pic et colegram", "Bourre et bourre et ratatam")
Ctrl.AddItem Elt
' Tahoma 8 = police des CommandBarControls
TempL = DimTexte(CStr(Elt), "Tahoma", 8).Largeur
If TempL > LargeurMax Then LargeurMax = TempL
Next Elt

' Ajustement de la largeur du contrôle
Ctrl.DropDownWidth = -1
Ctrl.Width = LargeurMax + 20 ' (marge de 20 pixels supplémentaire)
Ctrl.ListIndex = 1

End Sub
 

Dudu2

XLDnaute Barbatruc
Bonjour Modeste geedee,
Merci pour ton retour.
La solution que tu proposes avec un Control un peu spécial est du même ressort mais évidemment beaucoup plus complexe à cause de l'absence d'AutoSize.
Avec ta fonction, en isolant la ligne la plus longue et en convertissant les pixels en points j'arrive à un résultat similaire.
Pour mes MsgBoxPerso et InputBoxPerso la solution miracle du WordWrap = False a mis un terme à de longs moments de questionnement sur la méthode et j'ai maintenant un comportement parfaitement sous contrôle.
Cordialement,
JP
 
Dernière édition:

jmfmarques

XLDnaute Accro
Bonjour à tous
Ainsi que je l'ai dit plus haut, il me semble préférable d'éviter pour ce faire de faire appel à des fonctions de l'API depuis VBA.
Si toutefois quelques-uns d'entre vous étaient vraiment intéressés par un outil permettant depuis VBA, de faire tout ce que font les fonctions VB6 en matière de conversion d'unités graphiques, et de calcul de dimensions graphiques de texte, qu'ils le disent et je déposerai ici ce que mon frère jumeau a un jour déposé ailleurs.:)
 

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 049
Membres
101 882
dernier inscrit
XaK_