Aide sur la mise en boucle d'une macro

**SPG except in VBA** · 10/07/2014, 15h31

Bonjour à tous,

Petit nouveau que je suis...je suis en train de faire mes premiers pas dans le language VBA, et je vous avoue je me m'amuse bien ! Je rencontre néammoins un problème dû à mon manque de connaissance. C'est donc aprés avoir chercher sans trouver de réponse que je me retourne vers vous amis du Forum

Explication Macro : Je viens d'arranger cette macro (voir ci-dessous). Elle consiste a copier-coller des graphiques depuis un tableau pivot dans excel vers un powerpoint, pour faire des présentations minutes. J'ai une variable qui change pour chaque graphique "NOM ENTREPRISE" et qui me permet de changer le filtre pour copier-coller plusieurs différents graphiques dans mon power point.

Où j'ai besoin d'aide : Ayant possiblement 50 graphiques à copier-coller je voudrais faire une boucle, qui me changerais cette variable selon une colonne où je rentrerais ma liste d'entreprises dont je veux copier-coller les graphiques. Et même encore mieux, avoir une fenêtre de dialogue qui s'ouvre au début de ma macro et où je peux choisir dans la liste du filtre les entreprises dont je veux les graphiques.

Ce à quoi j'ai pensé : Pour l'instant la meilleure option que j#ai trouvé serais de faire une boucle "Do Loop" sur la liste de nom, comme expliquer dans ce Tuto : http://silkyroad.developpez.com/vba/boucles/#LIV , mais je n'arrive pas appliquer à ma macro...

Je ne m'attend pas (et je ne veux pas vraiment) avoir une réponse toute faite, mais plutôt des directions à prendre pour arriver à mon but car je souhaite apprendre avant tout.

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
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
 
With PptDoc
 
    '--- Ajoute un Slide
    .Slides.Add Index:=1, Layout:=ppLayoutBlank
    
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
    
    '--- Premier changement
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = "NOM ENTREPRISE"

 
    'copie le 1er graphique contenu dans la feuille Excel active
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    'collage dans la 2eme diapositive
    PptDoc.Slides(2).Shapes.Paste
    
 
    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count
 
    'Renomme et met en forme l'objet collé
    With Diapo.Shapes(NbShpe)
        .Name = "monGraph" 'personnalise le nom
        .Left = 150 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With


    
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
    
    '--- Premier changement
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = "NOM ENTREPRISE"

 
    'copie le 1er graphique contenu dans la feuille Excel active
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    'collage dans la 2eme diapositive
    PptDoc.Slides(2).Shapes.Paste

 
    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count
 
    'Renomme et met en forme l'objet collé
    With Diapo.Shapes(NbShpe)
        .Name = "monGraph" 'personnalise le nom
        .Left = 150 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With
 
 
    
End With
 
 
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
 
MsgBox "Opération terminée."
End Sub

**ANOVA** · 10/07/2014, 17h19

Est-ce que ça ça t'aide ?

Code :

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

1
2
3
4
5
6
7
Sub toto()
    Dim graphique As Chart
 
    For Each graphique In ThisWorkbook.Charts
        Debug.Print graphique.Name
    Next graphique
End Sub

**SPG except in VBA** · 10/07/2014, 18h10

Oui ! Du moins J'ai compris comment fonctionner une boucle... J'en juste utiliser une autre, maintenant j'ai ca, et ca marche ! Merci beaucoup ! Je vais chercher pour pouvoir faire la sélection dans une boite de dialogue !

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
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
 
Dim retailer As String
With PptDoc
 
 '--- Ajoute un Slide
    .Slides.Add Index:=1, Layout:=ppLayoutBlank
    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
        Left:=100, Top:=100, Width:=150, Height:=60)
    'insère la valeur de la Cellule A1 dans une zone de texte
    Sh.TextFrame.TextRange.Text = Range("A1")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)
 
 
    For Counter = 1 To 3
    retailer = Worksheets("Retailer Analysis").Cells(Counter, 20)
 
 
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
 
    '--- Premier changement
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = retailer
 
 
    'copie le 1er graphique contenu dans la feuille Excel active
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    'collage dans la 2eme diapositive
    PptDoc.Slides(2).Shapes.Paste
 
 
    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count
 
    'Renomme et met en forme l'objet collé
    With Diapo.Shapes(NbShpe)
        .Name = "monGraph" 'personnalise le nom
        .Left = 150 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With
    Next Counter
 
 
 
End With
 
 
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
 
MsgBox "Opération terminée."
End Sub

**ANOVA** · 11/07/2014, 09h39

ok, qu'entends tu par sélection dans une boite de dialogue ?

Juste un truc quand tu programmes, il faut éviter de faire des sélections et des activate. Ca, c'est la façon de programmer des macros enregistrées, mais c'est pas de la bonne programmation.

Par exemple :

Code :

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

1
2
3
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

doit s'écrire :

Code :

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

ActiveSheet.ChartObjects(1).CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

En effet, ta première ligne fait en sorte que ActiveChart désigne ActiveSheet.ChartObjects(1), à mon avis (sans avoir fait de test) ta deuxième ligne ne sert à rien et ta troisième ligne utilise la méthode CopyPicture de ActiveSheet.ChartObject(1) on peut donc y accéder en une ligne via ActiveSheet.ChartObjects(1).CopyPicture.

Même le ActiveSheet est à proscrire. Il faut faire un Dim Feuille As Worksheet ; Set Feuille = Worksheets(1) ou tu fais un For Each comme pour les graphiques (ça s'appelle parcourir les éléments d'une Collection).

La différence est importante car tu gagnes en temps de calcul et tu évites des bugs. En effet, avec ta méthode, tu ne peut désigner qu'un objet actif à la fois. Alors qu'en déclarant tes objets, tu pourras faire des opérations sur plusieurs objets et il n'y a pas besoin que la feuille ou le graphique soient affichés pour pouvoir effectuer des opérations dessus.

**SPG except in VBA** · 11/07/2014, 13h01

Par sélection dans une boîte de dialogue, je pensais présenter une boite de dialogue où l'on puisse coller une liste qui se collerais à son tour dans une colonne donné et o'u je pourrais faire tourner ma boucle :

Code :

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

1
2
3
4
5
For Counter = 1 To 3
    retailer = Worksheets("Retailer Analysis").Cells(Counter, 20)
.
.
.

Ou sinon une boîte de dialogue où l'on puisse sélectionner les "retailers" directement depuis le filtre du TCD des graphiques.

Je viens d'essayer ton code en le tournant dans tout les sens, mais je n'ai pas réussi à le faire marcher x)

Ensuite pour remplacer le ActiveSheet, ca donnerais quelque chose comme ca ?

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
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
57
58
59
60
61
62
63
64
65
66
67
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add

Dim Feuille As Worksheet
Set Feuille = Worksheet ("nom de ma feuille")

Dim retailer As String
With PptDoc
    
 '--- Ajoute un Slide
    .Slides.Add Index:=1, Layout:=ppLayoutBlank
   
    
    
    For Counter = 1 To 3
    retailer = Worksheets("Retailer Analysis").Cells(Counter, 20)
'--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
    
    '--- Premier changement
    Feuille.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
    Feuille.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = retailer

 
    'copie le 1er graphique contenu dans la feuille Excel active
    Feuille.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

    'collage dans la 2eme diapositive
    PptDoc.Slides(2).Shapes.Paste
    
 
    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count
 
    'Renomme et met en forme l'objet collé
    With Diapo.Shapes(NbShpe)
        .Name = "monGraph" 'personnalise le nom
        .Left = 150 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With
    Next Counter

 
    
End With
 
 
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
 
MsgBox "Opération terminée."
End Sub

Je suis en train d'insérer un sécurité par rapport à ma variable "retailer" , car si l'utilisateur rentre un mauvais mot, la macro plante.

Merci pour tes conseils et ton aide Anova !

Ceci n'est qu'une partie d'une plus grosse macro que je suis en train de faire. J'aurais surement besoin d'aide sur d'autre problèmes ! ^^

Je viens de tester pour enlever le ActiveSheet, ca marche ! Mais je n'arrive toujours pas à appliquer ton "raccourci" de commande.

**clementmarcotte** · 11/07/2014, 21h56

Bonjour

Envoyé par SPG except in VBA

Je viens de tester pour enlever le ActiveSheet, ca marche ! Mais je n'arrive toujours pas à appliquer ton "raccourci" de commande.

Anova te dis cela:

Code :

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

 Set Feuille = Worksheets(1)

Et toi tu écris cela:

Code :

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

Set Feuille = Worksheet ("nom de ma feuille")

Donc, il te manque une lettre à quelque à quelque part; pour différencier un objet de sa collection d'objets.

Aide sur la mise en boucle d'une macro

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager