Set rng = page de mise en page

Version imprimable

Bonjour à tous,
pour une besoin pro j'ai récupérer la marco suivante de Philippe PONS,
ma question :
est il possible de faire correspondre "set rng" a mes différente page d'une feuille excel ?

Car sur une même feuille j'ai 6 pages différentes dont la taille peux varier mais pas la mise en page.

je suis conscient qu'il y à beaucoup de fois pages dans cette page ...

Merci de votre aide précieuse

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
Sub exportRange()
    Dim sh As Worksheet
    Dim rng As Range
    Dim chartobj As ChartObject
 
    Dim output As String
    Dim zoom_coef As Double
    ' référence sur la feuille qui contient la plage à exporter
    Set sh = Worksheets("Données sources")
    ' le fichier image
    output = "c:\test\SavedRange4.jpg"
    ' el zoom
    zoom_coef = 100 / sh.Parent.Windows(1).Zoom
    ' sélectionner la plage à exporter
    Set rng = sh.Range("A1").CurrentRegion
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
 
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
End Sub

18/10/2018, 12h10
Thautheme

Bonjour Gwilym (P... ! que c'est dur à écrire...), bonjour le forum,

Sans connaître l'adresse de début des 6 plages, difficile de t'aider... Tes 6 plages sont elles bien séparées les une des autres par au moins une ligne vide ?
18/10/2018, 12h16
Gwilym

Plus que Thautheme -< j'ai du le copier/coller ;) ?

oui au moins une ligne vide entre chaque

après je pourrais rentré les range de chaque plage mais elle peuvent être amené à changer

pour exemple

page 1 : A1:K9
Page 2 : A10:K21
page 3 : A22:K35 ou 36...
18/10/2018, 12h29
Thautheme

Re,

Citation:

Envoyé par Gwilym

Plus que Thautheme -< j'ai du le copier/coller ;) ?

C'est pas faux !... Mort de rire...

Et à défaut du fichier qui va bien, une ou quelques captures d'écran seraient les bienvenues...
18/10/2018, 13h41
Gwilym

1 pièce(s) jointe(s)

Voila un exemple page 1 et page 2

Pièce jointe 420298

Re,

Essaie comme ça :

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
Sub exportRange()
    Dim sh As Worksheet
    Dim rng As Range
    Dim chartobj As ChartObject
    Dim output As String
    Dim zoom_coef As Double
 
    ' référence sur la feuille qui contient la plage à exporter
    Set sh = Worksheets("Données sources")
    ' le fichier image
    output = "c:\test\SavedRange4.jpg"
    ' el zoom
    zoom_coef = 100 / sh.Parent.Windows(1).Zoom
    ' sélectionner la plage à exporter
    Set rng = sh.Range("A1").CurrentRegion
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
 
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
 
For i = 1 To ActiveSheet.HPageBreaks.Count
    Set rng = Range(ActiveSheet.HPageBreaks(i).Location.Address).CurrentRegion
    'le code
Next i
End Sub

Comme ça ?

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
Sub exportRange()
    Dim sh As Worksheet
    Dim rng As Range
    Dim chartobj As ChartObject
    Dim output As String
    Dim zoom_coef As Double
 
    ' référence sur la feuille qui contient la plage à exporter
    Set sh = Worksheets("Données sources")
    ' le fichier image
    output = "c:\test\SavedRange4.jpg"
    ' el zoom
    zoom_coef = 100 / sh.Parent.Windows(1).Zoom
    ' sélectionner la plage à exporter
For i = 1 To ActiveSheet.HPageBreaks.Count
    Set rng = Range(ActiveSheet.HPageBreaks(i).Location.Address).CurrentRegion    
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
 
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
 
Next i
End Sub

Re,

Là tu ne vas pas agir sur ta première page... Je n'ai pas recopié le code initial dans la boucle car ne le l'ai pas compris mais tu devrais faire avec ton code initial plus la boucle (que j'ai modifiée avec -1) :

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
Sub exportRange()
    Dim sh As Worksheet
    Dim rng As Range
    Dim chartobj As ChartObject
    Dim output As String
    Dim zoom_coef As Double
 
    ' référence sur la feuille qui contient la plage à exporter
    Set sh = Worksheets("Données sources")
    ' le fichier image
    output = "c:\test\SavedRange4.jpg"
    ' el zoom
    zoom_coef = 100 / sh.Parent.Windows(1).Zoom
    ' sélectionner la plage à exporter
    Set rng = sh.Range("A1").CurrentRegion
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
 
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
 
For i = 1 To ActiveSheet.HPageBreaks.Count - 1
    Set rng = Range(ActiveSheet.HPageBreaks(i).Location.Address).CurrentRegion
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
 
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
   'le code
Next i
End Sub

Sinon, plutôt que de poser des questions, pourquoi ne testes-tu pas ?...

18/10/2018, 16h22
Gwilym

j'ai posé la question parce que j'ai tester et que ça a pas donner le résultat que j’espérais du coup
j'ai préféré demander pour voir si j'avais pas fait une erreur en recopiant

Du coup comme je connais forcément la case de départ de mon tableau et qu'ils sont forcément séparés
en faisant :

Code:

Set rng = sh.Range("A11").CurrentRegion

ça passe, même en sélection multiple.

Merci de tes conseils qui ont fait naitre cette idée dans mon esprit fatigué.

a plus

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
If CheckBox2 = True Then
    LaDate = Format(Date, "dd-mm-yyyy")
    LeParcours = CheckBox2.Caption & " - " & ActiveSheet.Name
    LeRep = "G:\*************\DIFFUSION\"
    ' le fichier image
    output = LeRep & LeParcours & " - " & LaDate & ".jpg"
    ' el zoom
    zoom_coef = 80 / sh.Parent.Windows(1).Zoom
    ' sélectionner la plage à exporter
    Set rng = sh.Range("A11").CurrentRegion
    ' copier dans le presse-papier
    rng.CopyPicture xlPrinter
    Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)
    chartobj.Chart.Paste
    ' exporter l'image
    chartobj.Chart.Export output, "JPG"
    ' supprimer
    chartobj.Delete
    End If