Impression Graphique Dynamique / Liste déroulante

[zoubitom]

Bnjour le Forum,

J'ai un fichier me permettant de visualiser sous forme graphique des données mensuelles jour par jour.
Pour pouvoir imprimer tous les graphiques sans les afficher 1 par 1, j'utilise le code suivant:

Private Sub CommandButton1_Click()
Dim c As Range
For Each c In [FeuilTmp15!B1:B31].Cells
[Graph15!F2] = c
ActiveSheet.ChartObjects("Graphique 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.PrintOut
Next
End Sub

Mon souci est que cela consomme beaucoup de papier (impression page par page).

Est-il possible de modifier ce code (ou d'en créer un autre) me permettant d'imprimer trois graphiques sur une meme page et en Rectoverso? (Rendu= 6 graphique par feuille R/V et 3 graphiques par page).

Merci pour votre aide, voir le fichier joint:

 

[kjin]

Re : Impression Graphique Dynamique / Liste déroulante

Bonsoir,
La macro exporte les graphs successivement et les recharge dans des contrôles images (maximum 6 par page), jusqu'au nb total de date dans la liste
Il faut que tu paramètres ton imprimante pour imprimer en Recto/Verso

Sub Impression()
Application.ScreenUpdating = False
Ftmp = ActiveWorkbook.Path & "\" & "Tmp.gif"
Set rngdate = Sheets("FeuilTmp15").Range("ListeChoixDate15")
nbDate = rngdate.Count
x = 1
Do
    For i = 1 To 6
        If x > nbDate Then Exit For
        Range("F2") = rngdate(x)
        ActiveSheet.ChartObjects(1).Chart.Export Ftmp, "GIF"
        Set Img = Sheets("Impression").DrawingObjects("Image" & i).Object
        Img.Picture = LoadPicture(Ftmp)
        Kill Ftmp
        x = x + 1
    Next
    Sheets("Impression").PrintOut
    For i = 1 To 6
        Set Img = Sheets("Impression").DrawingObjects("Image" & i).Object
        Img.Picture = LoadPicture("")
    Next
Loop Until x > nbDate
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[zoubitom]

Re : Impression Graphique Dynamique / Liste déroulante

Bonjour Kjin, le forum,

Tout d'abord merci pour ta réponse, cela correspond à ce que je souhaite mais 2 problèmes se posent:

1. 
   Si je lance l'impression sur un mois complet (soit 31 jours et non 9 jours comme l'exemple) cela ne m'imprime que les graphiques 1 à 6 plusieurs fois, soit 5 pages R/V identiques. Dans ce cas faut-il "préparer" l'onglet <Impression> avec toute les zones images? et changer dans le code:
   

   For i = 1 To 6

   par
   

   For i = 1 To 31

   Dans ce cas, comment faire?
   
   
2. L'execution de la macro est plutôt lente, n'y a-t-il pas un moyen de l'optimiser?

Tom.

 

[zoubitom]

Re : Impression Graphique Dynamique / Liste déroulante

Bonjour le forum,

Je n'arrive toujours à trouver de solutions...
Quelqu'un pour aider?

 

[kjin]

Re : Impression Graphique Dynamique / Liste déroulante

Bonjour,

Si je lance l'impression sur un mois complet (soit 31 jours et non 9 jours comme l'exemple) cela ne m'imprime que les graphiques 1 à 6 plusieurs fois,

Modifie la macro comme ceci

Sub Impression()
Application.ScreenUpdating = False
Ftmp = ActiveWorkbook.Path & "\" & "Tmp.gif"
Set rngdate = Sheets("FeuilTmp15").Range("ListeChoixDate15")
nbDate = rngdate.Count
x = 1
Do
    For i = 1 To 6
        If x > nbDate Then Exit For
        Range("F2") = rngdate(x)
        ActiveSheet.ChartObjects(1).Chart.Export Ftmp, "GIF"
        Sheets("Impression").OLEObjects("Image" & i).Object.Picture = LoadPicture(Ftmp)
        Kill Ftmp
        x = x + 1
    Next
    [COLOR="Blue"]Sheets("Impression").PageSetup.FirstPageNumber = 1[/COLOR]
    Sheets("Impression").PrintOut
    For i = 1 To 6
        Sheets("Impression").OLEObjects("Image" & i).Object.Picture = LoadPicture("")
    Next
Loop Until x > nbDate
Application.ScreenUpdating = True

End Sub

L'execution de la macro est plutôt lente, n'y a-t-il pas un moyen de l'optimiser?

Compte tenu du travail à réaliser et de la procédure, ça me parait plutôt normal
J'ai qq peu modifié le code, mais je ne vois guère d'autre solution
A+
kjin

 

[zoubitom]

Re : Impression Graphique Dynamique / Liste déroulante

Bonsoir à tous,

Merci kjin, je dois dire que c'est déjà pas mal et que même si la macro est lente, cela me permet de gagner pas mal de temps et de papier...
Donc ta solution me convient bien pour le moment.

Question bete: comment tu définis tes zone d'image dans l'onglet <Impression>?

 

[kjin]

Re : Impression Graphique Dynamique / Liste déroulante

Bonsoir,
Ce sont des controles ActiveX disponibles lorsque tu cliques sur la boite à outils contrôlesdans la barre de menu VBE; pour les éditer click sur l'équerre pour passer en mode Création.
Une autre solution consisterait à copier 6 fois ton graphique sur la feuille impression et pour 5 des copies, créer un décalage par rapport à la date sélectionnée dans la feuille graphe
Je tente de regarder
A+
kjin

 

[zoubitom]

Re : Impression Graphique Dynamique / Liste déroulante

Bonsoir,

OK pour les controles activeX.
Depuis, j'ai un autre souci:

Sur un fichier léger tel que le fichier exemple, ça marche bien.
Cependant, sur un fichier plus lourd, l'actualisation des graphiques est plus lente.
Du coup, j'ai l'impression que mes graphiques ne s'actualisent pas assez vite par rapport à la macro <impression> et donc j'obtiens toujours les mêmes courbes après impression (alors que les dates s'actualisent bien).
Cela vous semble-t-il "logique" étant donné le code:

Sub Impression()
Application.ScreenUpdating = False
Ftmp = ActiveWorkbook.Path & "\" & "Tmp.gif"
Set rngdate = Sheets("FeuilTmp15").Range("ListeChoixDate15")
nbDate = rngdate.Count
x = 1
Do
    For i = 1 To 6
        If x > nbDate Then Exit For
        Range("F2") = rngdate(x)
        ActiveSheet.ChartObjects(1).Chart.Export Ftmp, "GIF"
        Sheets("Impression").OLEObjects("Image" & i).Object.Picture = LoadPicture(Ftmp)
        Kill Ftmp
        x = x + 1
    Next
    Sheets("Impression").PageSetup.FirstPageNumber = 1
    Sheets("Impression").PrintOut
    For i = 1 To 6
        Sheets("Impression").OLEObjects("Image" & i).Object.Picture = LoadPicture("")
    Next
Loop Until x > nbDate
Application.ScreenUpdating = True

End Sub