Impression en PDF suite à sélection multiple dans zone de liste

Version imprimable

26/09/2011, 12h45
lumpys

Impression en PDF suite à sélection multiple dans zone de liste

Bonjour,

J'ai un graphique dont les données s'affichent suite à une sélection dans une zone de liste modifiable (la sélection ne peut être que simple). Pour afficher l'ensemble des graphiques, il faut sélectionner 1 à un les données de la zone de liste modifiable. Je souhaiterai pouvoir réaliser une sélection multique et que l'ensemble des graphiques puisse s'imprimer dans un même document en PDF (j'utilise PDF Creator). J'ai pensé à créer une zone de liste (à sélection multiple) dans un userform, mais je ne sais pas très bien ensuite comment faire pour qu'il concatène l'ensemble des graphiques dans un même document PDF. J'espère que je suis clair un minimum. Merci d'avance pour les réponses que vous pourrez m'apporter.
26/09/2011, 13h30
Godzestla

Bonjour,

Dans la mesure ou tes graphiques sont chacun sur une feuille et que chaque feuille avec graphique ne contient rien d'autre, il est très facile de sélectionner les feuilles et puis d'imprimer uniquement les feuilles sélectionnées, vers ton imprimante PDf Creator. Tu auras ainsi sans difficulté un seul PDf avec tes graphiques.
26/09/2011, 15h27
lumpys

1 pièce(s) jointe(s)

Les graphiques ne sont pas sur des feuilles différentes. Un graphique est sur une feuille. En sélectionnant une donnée dans une zone de liste déroulante, on modifie l'affichage du graphique. Cf. ci-joint un exemple du fichier que j'utilise.
26/09/2011, 16h07
Godzestla

Une solution possible est alors de générer autant de feuilles temporaires que tu as d'options dans ta liste déroulante (ici 4), avec pour chacune une valeur de cette liste déroulante.
Tu nommes ces feuilles par exemple du nom de la sélection. Puis tu les sélectionnes toutes, tu imprime la sélection, puis tu les effaces.

Avant la génération suivante pour impression, il est prudent de vérifier l'existence des feuilles temporaires et de les supprimer.
26/09/2011, 17h52
lumpys

Je ne suis pas sûr que cette façon de fonctionner soit géniale pour la mémoire. Ma sélection peut être importante, ce qui génèrerai un nombre important de feuilles. Merci quand même pour l'idée.

Si quelqu'un à une autre idée, n'hésitez pas ...

Bonjour,

Le principe est d'empiler les graphiques les uns sous les autres sur la feuille nommée Imp à l'aide d'une Listbox à sélection multiple et d'un bouton de commande. J'ai supprimé la combobox d'origine. Tu dois modifier les dimensions des graphiques. L'indice de chaque valeur sélectionnée est mise en A1 :

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
Private Sub CommandButton1_Click()
    For Each sh In Sheets("Imp").Shapes
        sh.Delete
    Next
    With ActiveSheet.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
               [A1] = i + 1
                Charts.Add
                Set v = ActiveChart
                ActiveChart.ChartType = xlLine
                ActiveChart.SetSourceData Source:=Sheets("Feuil1 (2)").Range("B4:D6"), _
                    PlotBy:=xlColumns
                ActiveChart.Location Where:=xlLocationAsObject, Name:="Imp"
                With ActiveChart
                    .ChartType = xlLine
                    .SetSourceData Source:=Sheets("Feuil1 (2)").Range("B3:D6"), _
                        PlotBy:=xlColumns
                    .Location Where:=xlLocationAsObject, Name:="Imp"
                    .HasTitle = True
                    .ChartTitle.Text = ['feuil1 (2)'!A4].Value
                End With
                ctr = ctr + 1
                Set sh = Sheets("Imp").Shapes(Sheets("Imp").Shapes.Count)
                sh.Height = 330
                sh.Width = 600
                sh.Left = 1
                sh.Top = 330 * (ctr - 1)
               .Selected(i) = False
            End If
        Next i
    End With
End Sub

29/09/2011, 16h42
lumpys

Merci. Ce programme fonctionne très bien et me permet d'obtenir ce que je souhaitais. Par contre, y a t-il un moyen de forcer un saut de page entre chaque graphique afin d'éviter qu'un graphique ne se retrouve séparer entre 2 pages ?

Bonjour,

Ouf, j'ai transpiré sur celui-ci :lol:
J'ai mis deux graphiques par page. Ce nombre est défini dans la valeur Ctr.
J'ai testé avec ton classeur exemple, mais il te reste à le tester à fond :

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
Private Sub CommandButton1_Click()
    'ma référence : lumpys.xls
    Dim Sh As Shape, Ctr As Long, Ctr1 As Long, Res As Double, ResBas As String
    On Error Resume Next
        For Each hpb In Sheets("Imp").HPageBreaks
            hpb.Delete
        Next
    On Error GoTo 0
    For Each Sh In Sheets("Imp").Shapes
        Sh.Delete
    Next
    Sheets("Imp").Cells.Clear
    With Sheets("Feuil1 (2)").ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
               [A1] = i + 1
                Charts.Add
                Set v = ActiveChart
                ActiveChart.ChartType = xlLine
                ActiveChart.SetSourceData Source:=Sheets("Feuil1 (2)").Range("B3:D6"), _
                    PlotBy:=xlColumns
                ActiveChart.Location Where:=xlLocationAsObject, Name:="Imp"
                With ActiveChart
                    .HasTitle = True
                    .ChartTitle.Text = ['feuil1 (2)'!A4].Value
                End With
                With Sheets("Imp")
                    Set Sh = .Shapes(.Shapes.Count)
                    Sh.Height = 250
                    Sh.Width = 400
                    Sh.Left = 1
                    Ctr = Ctr + 1
                    If Ctr = 3 Then
                        Ctr = 1
                        Set hpb = .HPageBreaks.Add(before:=Range(ResBas))
                        Res = Range(ResBas).Offset(-1).Top
                    End If
                    Sh.Top = Res + (250 * (Ctr - 1))
                    ResBas = Sh.BottomRightCell.Offset(1).Address
                End With
               .Selected(i) = False
            End If
        Next i
    End With
End Sub

A ta disposition pour toute explication complémentaire.

... pas fini de transpirer, les séries sont toutes égales à celles du dernier graphique.

Ceci... peut-être :

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
51
52
53
54
55
56
Private Sub CommandButton1_Click()
    'ma référence : lumpys.xls
    Dim Sh As Shape, Ctr As Long, Ctr1 As Long, Res As Double, ResBas As String
    Dim Plg As Range
    With Sheets("Feuil1 (2)")
        .Range(.[A15], .Cells(Rows.Count, 3).End(xlUp)).ClearContents
    End With
    On Error Resume Next
    For Each hpb In Sheets("Imp").HPageBreaks
        hpb.Delete
    Next
    On Error GoTo 0
    For Each Sh In Sheets("Imp").Shapes
        Sh.Delete
    Next
    Sheets("Imp").Cells.Clear
 
    With Sheets("Feuil1 (2)").ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
               [A1] = i + 1
               Sheets("Feuil1 (2)").Range("B3:D6").Copy
               Sheets("Feuil1 (2)").Cells(i * 4 + 15, 1).PasteSpecial xlValues
               Set Plg = Sheets("Feuil1 (2)").Cells(i * 4 + 15, 1).Resize(4, 3)
                Charts.Add
                ActiveChart.ChartType = xlLine
                Var = Plg.Address
                ActiveChart.SetSourceData Source:=Sheets("Feuil1 (2)").Range(Plg.Address), _
                    PlotBy:=xlColumns
                ActiveChart.Location Where:=xlLocationAsObject, Name:="Imp"
                With ActiveChart
                    .HasTitle = True
                    .ChartTitle.Text = ['feuil1 (2)'!A4].Value
                    For Each s In .SeriesCollection
 
                    Next s
                End With
                With Sheets("Imp")
                    Set Sh = .Shapes(.Shapes.Count)
                    Sh.Height = 250
                    Sh.Width = 400
                    Sh.Left = 1
                    Ctr = Ctr + 1
                    If Ctr = 3 Then
                        Ctr = 1
                        Set hpb = .HPageBreaks.Add(before:=Range(ResBas))
                        Res = Range(ResBas).Offset(-1).Top
                    End If
                    Sh.Top = Res + (250 * (Ctr - 1))
                    ResBas = Sh.BottomRightCell.Offset(1).Address
                End With
               .Selected(i) = False
            End If
        Next i
    End With
End Sub

19/10/2011, 16h45
lumpys

Bonjour,

Je viens juste de m'y remettre (pas eu le temps avant). Le code ci-dessus fonctionne très bien avec le fichier exemple, merci. Par contre, j'ai quelques soucis pour l'adapter à mon document d'origine, d'où ma question : à quoi correspondent les chiffres 4 et 15 dans la ligne suivante "i * 4 + 15"
19/10/2011, 17h55
Daniel.C

Ca m'apprendra à commenter !

i est l'indice des graphiques sélectionnés dans la listbox. Le problème que j'ai dû résoudre est que chaque graphique doit avoir sa propre plage de données.pour le premier graphique, j'ai copié la plage B3:D6 avec i=0 soit en A15. Le suivant avec i=1 4 lignes plus bas soit i*4+15, soit en ligne 19 etc.
20/10/2011, 13h15
lumpys

1 pièce(s) jointe(s)

Merci pour la réponse. J'ai essayé d'intégrer un UserForm, plutot que de tout faire à partir de la "Feuil1 (2)". Ca fonctionne, sauf pour le saut de page qui ne se fait pas et je n'arrive pas trouver d'où cela peut venir. Une idée ?

Ci-joint le fichier.
20/10/2011, 15h16
Daniel.C

Bon, Ça change pas mal. Il faudrait que tu me confirme le nombre de graphiques par page. Tu n'auras sans doute pas de réponse avant demain soir.
20/10/2011, 15h43
lumpys

Dans l'idéal, un graphique par page (en paysage) comme la page Graph2 lorsqu'on l'a met en apercu avant impression.
Je m'aperçois finalement que le saut de page semble se faire mais le 3ème graphique se met à la suite du 2nd sans tenir compte du saut de page.

Teste la macro à rattacher au bouton de l'userform :

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
51
Private Sub CommandButton1_Click()
   'ma référence
    Dim Sh As Shape, Ctr As Long, Ctr1 As Long, Res As Double, ResBas As String
    Dim Plg As Range, test, Haut As Double
    ResBas = "A1"
    With Sheets("Feuil1 (2)")
        .Range(.[A22], .Cells(Rows.Count, 5).End(xlUp)).ClearContents
    End With
    On Error Resume Next
    For Each hpb In Sheets("Imp").HPageBreaks
        hpb.Delete
    Next
    On Error GoTo 0
    For Each Sh In Sheets("Imp").Shapes
        Sh.Delete
    Next
    Sheets("Imp").Cells.Clear
    Sheets("Imp").PageSetup.Orientation = xlLandscape
 
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
               Sheets("Feuil1 (2)").[A1] = i + 1
               Sheets("Feuil1 (2)").Range("ZoneGraph").Copy
               Sheets("Feuil1 (2)").Cells(i * 15 + 22, 1).PasteSpecial xlValues
               Set Plg = Sheets("Feuil1 (2)").Cells(i * 15 + 22, 1).Resize(15, 5)
                Charts.Add
                ActiveChart.ChartType = xlLine
                ActiveChart.SetSourceData Source:=Sheets("Feuil1 (2)").Range(Plg.Address), _
                    PlotBy:=xlColumns
                ActiveChart.Location Where:=xlLocationAsObject, Name:="Imp"
                With ActiveChart
                    .HasTitle = True
                    .ChartTitle.Text = ['feuil1 (2)'!A4].Value
                End With
                UserForm1.Hide
                With Sheets("Imp")
                    Set Sh = .Shapes(.Shapes.Count)
                    Sh.Top = Range(ResBas).Top
                    Sh.Height = 330
                    Sh.Width = 530
                    Sh.Left = 1
                    ResBas = Sh.BottomRightCell.Offset(2).Address
                    Set hpb = .HPageBreaks.Add(before:=Range(ResBas))
                End With
               ListBox1.Selected(i) = False
            End If
        Next i
 
Unload UserForm1
 
End Sub