Discussion :

[wouana19]

Hello à tous,

Pas vraiment de questions pour une fois, mais plutôt un partage.

J'ai dû élaborer une feuille de calcul imprimable pour un client, et j'avais besoin de pouvoir définir des largeurs de colonne en mm pour correspondre à un document Word. J'aurai pu le faire à l'oeil mais j'ai préféré creuser un peu plus en profondeur la problématique des largeurs de colonne avec Excel. Histoire de mieux comprendre....

• Les largeurs se définissent avec Range().ColumnsWidth, valeur exprimée en nombre de caractères du style Normal mais majorée avec une marge. Donc définir 5 caractères ne donnera pas toujours la même largeur de colonne en cm, ni en cm.
• La largeur des colonnes a un palier de 1 pixel (je l'ai compris en codant)
• 1 pixel n'a pas une dimension identique sur tous les écrans

Ne connaissant pas l'intégration des API dans mon code VBA, j'ai préféré y aller un peu par tâtonnement. J'ai créé un tableau me donnant les correspondance entre :

• Nombre de pixels => tâtonné
• Nombre de caractères => qui est la propriété range().ColumnWidth (en lecture/écriture)
• Nombre de points => Range().Width qui me permet ensuite de trouver les cm
• Largeur en centimètre => calculée
• Largeur en millimètre => calculée
• Largeur en centimètre arrondi => calculée

Le tableau créé avec le code ci-dessous me permettra d'effectuer une function de recherche pour définir mes largeurs de colonne en cm avec une précision acceptable. de toute façon on ne pourra pas être plus précis.

Selon l'article https://docs.microsoft.com/en-us/pre...ectedfrom=MSDN je devrais encore tenir compte de l'impression on non des bordures pour être plus précis... mais je m'arrête là.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
'Référence : https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2010/cc802410(v=office.14)?redirectedfrom=MSDN
 
' Recherche personnelle pour définir la largeur des colonnes en centimètres
' Code mise à disposition sur https://www.developpez.net/forums/f664/logiciels/microsoft-office/excel/macros-vba-excel/
' Code écrit pas Wouana19, 07.02.2022
 
Sub Creation_Tableau_Correspondance()
 
    Dim ws As Worksheet
    Dim cel As Range
    Dim celWidth As Double
    Dim tbCor
    Dim i As Long
    Dim y As Long
    Dim LastL As Double
 
    Set ws = ActiveSheet
    Set cel = ws.Range("K2")   'Cellule testé
 
    ReDim tbCor(5, 0)           'Création du tableau
 
    Application.ScreenUpdating = False
 
    'Suppression du tableau s'il existe
    If ws.ListObjects.Count >= 1 Then ws.ListObjects(1).Delete
 
    For y = 0 To 100000
 
        'Défini la largeur de la colonne
        cel.ColumnWidth = y * 0.01
 
        'Si la largeur est réélement modifiée, 1 pixel de plus que l'enregistrement précédent
        If cel.ColumnWidth <> LastL Then
 
            'Redimensionnement du tableau
            ReDim Preserve tbCor(UBound(tbCor, 1), i)
 
            'Largeur en point
            celWidth = cel.Width
 
            tbCor(0, i) = i + 1                         'Nbr de pixels de la colonne
            tbCor(1, i) = cel.ColumnWidth               'Nbr de Caractères de la colonne
            tbCor(2, i) = celWidth                      'Nbr de Points de la colonne
            tbCor(3, i) = celWidth / Application.CentimetersToPoints(1)             'Largeur en cm
            tbCor(4, i) = celWidth / Application.CentimetersToPoints(1) * 10        'Largeur en mm
            tbCor(5, i) = Round(celWidth / Application.CentimetersToPoints(1), 2)   'Largeur en cm Arrondi
 
            'Garde en mémoire la largeur en pixel de la colonne
            LastL = cel.EntireColumn.ColumnWidth
 
            'Sortie dès xx cm
            If Round(celWidth / Application.CentimetersToPoints(1), 2) >= 30 Then GoTo Fin_de_Recherche
 
            'Sortie dès 254 caractères, limite d'Excel
            If cel.EntireColumn.ColumnWidth >= 254 Then GoTo Fin_de_Recherche
 
            i = i + 1
 
        End If
 
    Next
 
Fin_de_Recherche:
 
    'redéfini la largeur de la colonne en taille par défaut
    cel.ColumnWidth = cel.Offset(0, 1).ColumnWidth
 
    Application.ScreenUpdating = True
 
    With ws
        .Cells(1, 1) = "Pixel"
        .Cells(1, 2) = "Car"
        .Cells(1, 3) = "Point"
        .Cells(1, 4) = "cm"
        .Cells(1, 5) = "mm"
        .Cells(1, 6) = "cmArr"
 
        'inscription du tableau dans les cellules
        .Range(ws.Cells(2, 1), .Cells(2, 1).Offset(UBound(tbCor, 2), UBound(tbCor, 1))) = Application.Transpose(tbCor)
        'Création d'un objet Tableau
        .ListObjects.Add xlSrcRange, .Cells(1, 1).CurrentRegion
    End With
 
    MsgBox "Fin de procédure", vbInformation
 
End Sub

Ce code fonctionne aussi avec la version Excel MAC.

Si vous avez des remarques elles sont les bienvenues.
++