calculer la largeur d'une page

Version imprimable

Bonjour,

Je suis en train de faire différentes mises en page et je veux que dans tous les cas, la largeur de la page imprimée soit identique.
J'ai donc fait en sorte que toutes les largeurs aient une valeur de 65 en me basant sur le code suivant :
Code:

1 2 3 4 5 6 7 8 Dim lalargeur As Double Dim colfin As Integer ActiveSheet.PageSetup.Zoom = 100 zone_impr = ActiveSheet.PageSetup.PrintArea colfin = Range(zone_impr).Columns.Count For Each cell In Range(Cells(1, 1), Cells(1, colfin)) lalargeur = lalargeur + cell.ColumnWidth Next cell
Bizarrement, je me suis aperçu que certaines pages s'imprimaient sans saut de page vertical alors que d'autres en necessitaient un.

J'ai alors vérifié les largeurs avec le même code mais basé sur "cell.width" au lieu de "cell.columnwidth".
Et j'ai alors vu que mes largeurs de pages variaient entre 570 et 670 ! (+ 17 %)

Premièrement, j'aimerais donc savoir pourquoi des pages qui ont exactement la même largeur quand on additionne les "columnwidth" peuvent avoir des largeurs très différentes quand on additionne les "width" ?

Deuxièmement, comment faire pour régler une largeur de colonne en se basant sur sa largeur de cellule (puisque les largeurs de colonnes en semblent pas fiables pour obtenir une même largeur à l'impression) ?

Comme mon intuition me disait qu'à chaque nouvelle colonne ajoutée, il devait y avoir des problèmes d'arrondis qui se font différemment avec les deux méthodes, j'ai fait les relevés pour comparer les rapports de grandeurs entre les deux types de largeurs et le nombre de colonnes des pages correspondantes. Globalement, les chiffres indiquent que je suis dans le vrai. Plus il y a de colonnes dans une page et plus la largeur en columnwidth est élevée par rapport à la largeur en width :

feuille width columnwidth rapport nb colonnes
6 564.75 64.99 8.69 6
8 570.75 65.08 8.77 7
7 570 64.99 8.77 7
9 570 64.98 8.77 7
10 570 64.98 8.77 7
11 573 64.77 8.85 9
4 576 65.08 8.85 8
2 578.25 65.11 8.88 9
16 582.75 64.8 8.99 15
12 585 64.97 9.00 11
3 587.25 64.97 9.04 11
15 592.5 65.2 9.09 17
14 596.25 64.82 9.20 19
1 595.5 64.7 9.20 13
5 597.75 61.08 9.79 19
13 604.5 58.79 10.28 28

06/04/2011, 19h44
Patrice740

Bonjour,

Avec ColumnWidth, l'unité de largeur de colonne est égale à la largeur d'un caractère du style Normal, une même valeur de largeur de feuille ne donne donc une même largeur réelle que pour une police du style Normal identique.
D'autre part, pour un même fichier, on obtient des valeurs différentes selon les versions d'Excel

Il est donc préférable d'utiliser Width car l'unité de largeur est le point (1/72ème de pouce) :

Code:

lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width

Cordialement
Patrice
06/04/2011, 21h25
soubichat
Merci beaucoup Patrice pour cet éclairage. Cela confirme ce que je pensais intuitivement, seule width est fiable.
Le problème c'est que pour lire des largeurs, on peut utiliser les deux méthodes. Par contre, lorsqu'il s'agit de les définir, je sais faire avec columnwidth :
Code:

1 2 3 For Each cell In Selection cell.ColumnWidth = 6 Next cell
par contre le même code avec width ne fonctionne pas :
Code:

1 2 3 For Each cell In Selection cell.Width = 30 Next cell
J'aimerais donc savoir si c'est définitivement impossible ou si c'est moi qui me trompe de code...

Sur Google je viens de voir :
The width, in points, of the range. Read-only Variant.

Si je comprends bien, cette propriété est en lecture seule.
Je pense donc que pour l'affecter à une plage, la seule solution est de faire une boucle qui augmente petit à petit les columnwidth jusqu'à ce que la valeur width soit celle que l'on veut obtenir. C'est ce que je fais déjà. Je pensais que c'était un peu du bricolage mais apparemment il n'y a pas d'autre solution.

Re,
C'est un problème que j'ai rencontré voila quelque années, j'avais finalement opté pour travailler avec des valeurs de largeur exprimées en pixels.
J'ai donc écris 2 fonctions :

une pour convertir la largeur exprimée en pixel en unité de largeur de colonnes pour ColumnWidth (Largeur)
une pour convertir en pixel une largeur en points mesurée avec Witdth (Conversion_Largeur_pt_en_px)

et une 3ème Arrondi, pour remplacer Round()

Je te les livre telles qu'elles sont, elles fonctionnent avec les versions 9, 10 (2002), 11 (2003) et 12 (2007) d'Excel (à tester avec 2010) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Function Largeur(ByVal Largeur_en_Pixel)
' Convertit la valeur de largeur d'une colonne exprimé en pixel dans Excel
' en unité de largeur de colonne Excel.
' Arguments : LargeurPx           [in] Largeur colonne en pixels
' 09/07/07    Patrice             Version 2.7
'
Dim Version_Excel As Single
 
Version_Excel = CSng(Val(Application.Version))
If Version_Excel < 11 Then
  Largeur = IIf(Largeur_en_Pixel < 12, Largeur_en_Pixel / 12, (Largeur_en_Pixel - 5) / 7)
ElseIf Version_Excel >= 11 Then
  If Largeur_en_Pixel < 11 Then
    Largeur = Int(Largeur_en_Pixel * 13 / 12 + 5 / 7) / 13
  Else
    Largeur = Int((Largeur_en_Pixel - 4) / 7 * 8) / 8
  End If
End If
Largeur = Arrondi(Largeur, 2)
 
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Function Conversion_Largeur_pt_en_px(LargeurPt)
' Convertit la valeur de largeur d'une colonne exprimée en unité de largeur Excel (Width en pt)
' en valeur de largeur exprimée en pixel.
' Note : Les unités de largeur Excel (en pt) ne sont pas des unités de largeur de colonne
' Arguments : LargeurPt           [in]  Largeur colonne en points
' 09/07/07    Patrice             Version 2.7
'
Dim Version_Excel As Single
 
Version_Excel = CSng(Val(Application.Version))
If Version_Excel < 11 Then
  Conversion_Largeur_pt_en_px = LargeurPt * 4 / 3
ElseIf Version_Excel >= 11 Then
  Conversion_Largeur_pt_en_px = LargeurPt * 161 / 125
End If
Conversion_Largeur_pt_en_px = Arrondi(Conversion_Largeur_pt_en_px, 0)
 
End Function

Code:

1
2
3
4
5
6
7
8
9
10
Private Function Arrondi(ByVal Nombre, ByVal Decimales)
' Remplace la fonction VBA Round() qui fonctionne mal pour les
' nombres de la forme 2a + 0,5 (arrondis à l'inférieur !!!)
' Arguments : Nombre              [in] Nombre à arrondir
'             Décimales           [in] Nombre de décimales
' 28/08/06    Patrice             Version 2.0
'
Arrondi = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales
 
End Function

Pour les utiliser :

Code:

1
2
3
4
5
Range("A1:C1").ColumnWidth = Largeur(NbreDePixels)
 
ou
 
NbreDePixels = Conversion_Largeur_pt_en_px(Range("A1:C1").Width)

Bon courage,
Cordialement
Patrice

Merci d'être allé cherché tous ces codes dans tes archives.
Quel travail pour tenter d'obtenir ce que Excel aurait pu réaliser en 1 ligne si ses concepteurs l'avaient voulu ainsi !

J'ai testé le code dans ma macro. Quand je la lance pour la 1ère fois, on est assez loin du bon résultat mais si on la relance deux autres fois, on arrive à ce que l'on veut.

Pour ceux que ça intéresse voici les deux versions d'une macro destinée à obtenir une largeur de page souhaitée (585 points pour cet exemple) en faisant varier les dimensions des cellules sélectionnées (sur une seule ligne).

Ma version :

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
Sub obtenir_largeur()
    'largeur feuille = largeur idéale en agissant sur les cellules sélectionnées
    Dim colfin As Integer
    Dim lalargeur, lalargeur_idéale, différence As Double
    Dim cell As Range
    ActiveSheet.PageSetup.Zoom = 100
    'une seule ligne
    If Selection.Rows.Count > 1 Then MsgBox "Il ne faut sélectionner qu'une seule ligne.": Exit Sub
    'toutes les colonnes sélectionnées d'égale largeur
    For Each cell In Selection
        cell.ColumnWidth = ActiveCell.ColumnWidth
    Next cell
    'calculer la largeur actuelle de la feuille
    ActiveSheet.Select
    zone_impr = ActiveSheet.PageSetup.PrintArea
    colfin = Range(zone_impr).Columns.Count
    lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
    'la largeur idéale
    Application.ScreenUpdating = False
    lalargeur_idéale = 585
    If lalargeur > lalargeur_idéale Then
        Do While lalargeur > lalargeur_idéale
            lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
            For Each cell In Selection
                If cell.Row = ActiveCell.Row Then
                    If cell.ColumnWidth < 0.05 Then MsgBox "taille 0.05 atteinte": Exit Sub
                    cell.ColumnWidth = cell.ColumnWidth - 0.1
                End If
            Next cell
        Loop
    Else
        Do While lalargeur < lalargeur_idéale
            lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
            For Each cell In Selection
                If cell.Row = ActiveCell.Row Then
                    cell.ColumnWidth = cell.ColumnWidth + 0.1
                End If
            Next cell
        Loop
    End If
    'noter la largeur finale
    lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
    MsgBox lalargeur
End Sub

La version inspirée par Patrice qui nécessite les 3 "functions" notées plus haut

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
Sub obtenir_largeur2()
    'largeur feuille = largeur idéale en agissant sur les cellules sélectionnées
    Dim colfin As Integer
    Dim lalargeur, lalargeur_idéale, différence As Double
    Dim cell As Range
    ActiveSheet.PageSetup.Zoom = 100
    'une seule ligne
    If Selection.Rows.Count > 1 Then MsgBox "Il ne faut sélectionner qu'une seule ligne.": Exit Sub
    'toutes les colonnes sélectionnées d'égale largeur
    For Each cell In Selection
        cell.ColumnWidth = ActiveCell.ColumnWidth
    Next cell
    'calculer la largeur actuelle de la feuille
    ActiveSheet.Select
    zone_impr = ActiveSheet.PageSetup.PrintArea
    colfin = Range(zone_impr).Columns.Count
    lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
    'la largeur idéale
    Application.ScreenUpdating = False
    lalargeur_idéale = 585
    différence = 585 - lalargeur
    Dim NbreDePixels As Integer
    Dim NbreDePoints As Integer
    NbreDePoints = différence / Selection.Cells.Count
    NbreDePixels = Conversion_Largeur_pt_en_px(NbreDePoints)
    For Each cell In Selection
        cell.ColumnWidth = cell.ColumnWidth + largeur(NbreDePixels)
    Next cell
    'noter la largeur finale
    lalargeur = ActiveSheet.Range(Cells(1, 1), Cells(1, colfin)).Width
    MsgBox lalargeur
End Sub