Discussion :

[gabi75]

Bonjour à tous,
Tout est dit dans le titre. Je réalise une présentation hebdomadaire en important des graphes et des plages de cellules d'un fichier Excel vers un fichier ppt.

Pour cela j'utilise le code 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
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
Sub NouvellePresentation()
'
' NouvellePresentation Macro
'
 
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
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("P:\Documentation \Stat \TemplateStats.ppt")
 
 With PptDoc
 
 
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
 
'--    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(2).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
       Left:=50, Top:=50, Width:=500, Height:=50)
    'insère la valeur de la Cellule A2 dans une zone de texte
    Sh.TextFrame.TextRange.Text = Range("A2")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(250, 0, 0)
 
    'copie le 1er graphique contenu dans la feuille Excel active
    Sheet10.ChartObjects(1).Copy
    'collage dans la 2eme diapositive
    Diapo.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 = 50 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 400 'hauteur
        .Width = 650 'largeur
    End With
 
End Sub

Je réitère le With pour chaque graphique à copier. mais voilà, tout marche bien quand il s'agissait de graphique fait sous Excel2003, mais depuis que je suis passé au 2007, les graphes qui s'ajouttent et dont la mise en forme sont ceux d'Office 2007 apparaissent en noir et blance sur le ppt.
Comment puis-je résoudre ce petit soucis ??

De plus comment ajouter dans le code précédent de la même manière que pour les graphes, une selection de cellules (contenant un graphe, mais parfois d'autres cellules voisines) dans un slide à part?
Normalement avant l'automatisation, je copiais la selection avec un special past en tant qu'image puis collait la selection sur un slide.

PS: j'ai activé la référence de Office.powerpoint

Merci pour vos réponses

Cordialement.

[gabi75]

Bonjour à tous,

A noter que pour mon petit soucis de couleur celui-ci est aussi présent lorsque j'effectue des copier/coller manuellement mais que j'arrive à le résoudre en faisant un copier/coller spécial en tant qu'image (bitmap).

Le tout est de maintenant passer cette information dans le code de mon post précédent.

[Invité]

Bonjour

Comme le collage spécial fonctionne, en VB c'est PasteSpecial, regardes dans l'aide il y a tous les paramètres que tu peux utiliser dont ppPasteBitmap

Philippe

[gabi75]

Bonjour Philippe ,

Tout d'abord merci pour ta réponse !!
Excuse-moi Philippe mais je suis ne suis pas un expert en programmation.

peux-tu détailler ta réponse s'il te plaît? Parce qu'en utilisant Diapo.Shapes.PasteSpecial à la place de Diapo.Shapes.Paste, le résultat reste le même.

En faisant une recherche dans l'aide, celle-ci ne reconnait aucune syntaxe comme ppPasteBitmap

[Invité]

Re

Je ne peux tester pour l'instant, mais :

Tu es dans Excel à priori, as tu référencé la bibliothèque PowerPoint ?
Si non, il faut déclarer la constante ppPasteBitmap avec sa valeur (tu la trouves dans l'explorateur d'objet), par exemple :

Code :

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

Dim Const ppPasteBitmap As Long = 1

Philippe

[gabi75]

J'ai ajouté ta ligne de code maiss avant compilation, j'ai un message Compile Error: Expected identifier"

[gabi75]

Bonjour,

Je n'ai pas arréter de chercher mais le problèmes subsiste toujours.
Les graphiques sont toujours en noir et blanc dans mon fichier powerpoint.
Que dois-je ajouter à ce code pour que me débarasser de ce défaut ?

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
Sub NouvellePresentation()
'
' NouvellePresentation Macro
'
 
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
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("P:\Documentation \Stat \TemplateStats.ppt")
 
 With PptDoc
 
 
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
 
'--    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(2).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
       Left:=50, Top:=50, Width:=500, Height:=50)
    'insère la valeur de la Cellule A2 dans une zone de texte
    Sh.TextFrame.TextRange.Text = Range("A2")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(250, 0, 0)
 
    'copie le 1er graphique contenu dans la feuille Excel active
    Sheet10.ChartObjects(1).Copy
    'collage dans la 2eme diapositive
    Diapo.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 = 50 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 400 'hauteur
        .Width = 650 'largeur
    End With
 
End Sub

S'il n'y a pas d'autres solutions que le collage spécial comment dois-je faire ?
Désolai Philippe mais je n'arrive pas à comprendre comment faire avec les informations que tu m'a fournit .

[Invité]

Re

Remplaces la ligne

Code :

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

Diapo.Shapes.Paste

par

Code :

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

Diapo.Shapes.PasteSpecial ppPasteMetafilePicture

pour voir

Philippe

[gabi75]

Super Merci, Philippe !

sa marche parfaitement