Discussion :

[thom07lamy]

Bonjour,
j'avais développé une macro VBA de mise en page automatique sous Excel 2003 qui visait, entre autres à optimiser le zoom sans changer le nombre de pages pour l'impression de la feuille.

Le code précédent était le suivant:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'On optimise le zoom
zoomOptimise = 0
nbPagesAuto = ThisWorkbook.Sheets("DAS").HPageBreaks.Count + 1
zoomAuto = ThisWorkbook.Sheets("DAS").PageSetup.Zoom
zoomActuel = zoomAuto
While zoomOptimise = 0 And zoomActuel < 400
    zoomActuel = zoomActuel + 1
    ThisWorkbook.Sheets("DAS").PageSetup.Zoom = zoomActuel
    nbPagesZoom = ExecuteExcel4Macro("GET.DOCUMENT(50)")
    If nbPagesZoom > nbPagesAuto Then
        zoomOptimise = zoomActuel - 1
    End If
Wend
ThisWorkbook.Sheets("DAS").PageSetup.Zoom = zoomOptimise

On a récemment basculé sous Excel 2010, et pour une raison qui m'échappe, ce code a fonctionné très bien pendant quelques temps. Mais depuis quelques jours, j'ai eu des erreurs dessus.
Du coup, j'ai adapté mon code avec les objets Excel 2010:

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
'On optimise le zoom
zoomOptimise = 0
nbPagesAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
zoomAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom
zoomActuel = zoomAuto
While zoomOptimise = 0 And zoomActuel < 400
    zoomActuel = zoomActuel + 1
    ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomActuel
    DoEvents 'un appel de ThisWorkbook.Sheets("Descriptif").PrintPreview irait, mais ça arrête le code
    nbPagesZoom = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
    If nbPagesZoom > nbPagesAuto Then
        zoomOptimise = zoomActuel - 1
    End If
Wend
ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomOptimise

Et ça marche pour la plupart de mes impressions automatiques, sauf une... Il faut reconnaître que a feuille est peut-être un peu lourde pour la mémoire de ce pauvre Excel (la zone d'impression est A1:AK478), mais je ne peux pas faire autrement hélas...

Donc, ce qu'il me faudrait c'est une instruction à la place du DoEvents, qui recalculerait l'aperçu avant impression (enfin juste son nombre de pages). J'espérais trouver ça dans les méthodes de l'objet PageSetup, mais il n'y a pas de méthodes pour cet objet.
Quant à la méthode PrintPreview de l'objet Worksheet, elle ouvre une autre fenêtre et bloque mon exécution (en plus c'est lent...).

Si quelqu'un a une idée, je suis preneur...
Cordialement,
Thomas

[thom07lamy]

Bonjour,
j'ai pu trouver quelque chose qui marche plutôt bien, mais il demeure un petit souci.
Le code fait bien ce que j'attends de lui en mode debug, mais en exécution, il "oublie" un bloc If...

Voici le code:

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
'On optimise le zoom
zoomOptimise = 0
nbPagesAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
zoomAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom
zoomActuel = zoomAuto
While zoomOptimise = 0 And zoomActuel < 400
    Application.PrintCommunication = False 'Optimise les performances pour le calcul de mise en page
    zoomActuel = zoomActuel + 1
    ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomActuel
    DoEvents 'Voir si cette instruction est maintenant facultative
    nbPagesZoom = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
    If nbPagesZoom > nbPagesAuto Then
        zoomOptimise = zoomActuel - 1
    End If
    Application.PrintCommunication = True 'Rétablit la communication avec l'imprimante
Wend
Application.PrintCommunication = False
ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomOptimise
ActiveWindow.View = xlNormalView
Application.PrintCommunication = True

Le problème qui demeure désormais est que, par exemple pour un zoom optimisé de 87%, il va me passer un zoom de 88%. Un peu comme si le code suivant était mal interprété:

Code :

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

1
2
3
If nbPagesZoom > nbPagesAuto Then
        zoomOptimise = zoomActuel - 1
    End If

Je vais continuer à gratter de toute façon, je pense que je suis sur la bonne piste.

Edit:
En fait, c'était juste la position du rétablissement de la comm avec l'imprimante.
Maintenant ça donne:

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
'On optimise le zoom
zoomOptimise = 0
nbPagesAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
zoomAuto = ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom
zoomActuel = zoomAuto
While zoomOptimise = 0 And zoomActuel < 400
    Application.PrintCommunication = False
    zoomActuel = zoomActuel + 1
    ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomActuel
    DoEvents 'Voir si cette ligne est utile
    Application.PrintCommunication = True 'Test sur l'emplacement du rétablissement de la comm avec l'imprimante
    nbPagesZoom = ThisWorkbook.Sheets("Descriptif").PageSetup.Pages.Count
    If nbPagesZoom > nbPagesAuto Then
        zoomOptimise = zoomActuel - 1
    End If
    'Application.PrintCommunication = True
Wend
Application.PrintCommunication = False
ThisWorkbook.Sheets("Descriptif").PageSetup.Zoom = zoomOptimise
ActiveWindow.View = xlNormalView
Application.PrintCommunication = True

Voilà, en espérant que ça pourra servir à quelqu'un...