[XL-2003] Dimensionner une colonne pour qu'elle puisse contenir un certain nombre de "W". [Résolu]

[marot_r]

Bonjour à tous et merci de votre temps et de votre aide.

J'ai un chiffrier Excel où j'aimerai définir la taille des colonnes en fonction de la taille du W dans ma police. Par exemple je voudrais une colonne qui puisse contenir 15 fois la lettre W.

Bien sur je pourrais avoir une colonne de brouillon, y entrer mes W dans la police choisie, faire un autofit dessus et récupérer la largeur de la colonne mais je trouve cela un 'cochon' donc y a-t-il une autre méthode ?

A+

[Daniel.C]

Bonsoir,

Désolé que ta solution te déplaise mais je n'en vois pas d'autre.

[marot_r]

Voici une solution même si elle donne le résultat en pixel (donc plus large que nécessaire) cela me suffira.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
' Dimensions de texte formaté en pixels.
' Laurent Longre au http://xcell05.free.fr/pages/api/dimtexte.htm
 
Option Explicit
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