De: Laurent Longre Objet: Re: GetTextWidth API from Excel Date : vendredi 22 septembre 2000 01:15 ds908@earthlink.net a écrit : > > Is there a way I can have Excel 97/2000 make an API call and get the > width of a string based on the string's contents, font, point size, > bold, etc.? The width would be returned as pixels/twips, whatever. > typically, calling this sort of API requires a handle to a device > context. That can be done in VC++ or VB. But how/where, does one get a > handle to a device context in Excel VBA? > > Thanks, this is a tough one. The following VBA function DimTexte(Texte, Police, Taille, Gras, Italique) returns the size in pixels of the string "Texte". Sorry, the names of the arguments are in French, and I am too lazy to translate them in english... :-( - Police = font name (for instance "Times New Roman") - Taille = size in points (for instance 12) - Gras = bold attribute (True / False - False by default) - Italique = italic attribute (True / False - False by default) The returned value is this structure : Type SDimTexte Largeur As Long Hauteur As Long End Type Largeur = Width in pixels Hauteur = Height in pixels For instance : Dim TextSize As SDimTexte TextSize = DimTexte("Hello, world !", "Arial", 20, True, True) MsgBox "Width = " & TextSize.Largeur & " pixels - Height = " _ & TextSize.Hauteur & " pixels" The Test Sub below inserts a DropDown control in a new CommandBar, fills it with some strings, and then fits the size of the control with the size (in pixels) of the longest string. Hope this helps, Laurent MVP Excel '==================================================================== 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 Then SelectObject hDC, hFont GetTextExtentPoint32A hDC, Texte, Len(Texte), DimTexte DeleteObject hFont End If ReleaseDC 0, hDC 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 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 '====================================================================