Passage d'excel à powerpoint

[C@thy]

Bonjour,

j'ai des TCD (un par feuille excel) et j'aimerais faire, par macro, un ppt avec ces TCD.

Est-ce possible, et si oui, quel serait le code?

Merci à vous et bonne journée

C@thy

 

[STephane]

Re : Passage d'excel à powerpoint

bonjour,

j'ai adapté un autre code que j'avais trouvé. je suppose qu'il y a un seul TCD par feuille (je ne sais pas si dans les dernières versions d'excel (2007 et +), on peut en avoir plusieurs).

la macro boucle sur les feuilles et copie tous les tableaux TCD (pas leurs graphiques TCD) du classeur dans un nouveau document powerpoint, un diapositif par tableau.

Sub Powerpoint_TCDCopy()
Dim pptApp As Object
Dim sTemplatePPt As String
Dim wks As Worksheet
Dim sTargetTop As Single
Dim sTargetLeft As Single
Dim sTargetWidth As Single
Dim sTargetHeight As Single
Dim sScaleHeight As Single
Dim sScaleWidth As Single
Dim iIndex As Integer

'Change these as desired
sTargetTop = 30
sTargetLeft = 60
sTargetWidth = 600
sTargetHeight = 450
sTemplatePPt = "C:\Program Files\Microsoft Office\Templates\Blank Presentation.pot"

iIndex = 1
Set pptApp = CreateObject("Powerpoint.Application")
With pptApp
.Visible = True
'.Presentations.Open _
FileName:=sTemplatePPt, Untitled:=msoTrue
.presentations.Add
For Each wks In Worksheets
If wks.PivotTables.count = 0 Then GoTo nnext_wks
wks.Select
.ActiveWindow.View.GotoSlide _
Index:=.ActivePresentation.Slides.Add _
(Index:=iIndex, Layout:=12).SlideIndex
iIndex = iIndex + 1
'wks.UsedRange.Copy
wks.Range(wks.PivotTables(1).TableRange2.Address).Copy
.ActiveWindow.View.Paste
With .ActiveWindow.Selection.ShapeRange
sScaleHeight = sTargetHeight / .Height
sScaleWidth = sTargetWidth / .Width
If sScaleHeight < sScaleWidth Then
sScaleWidth = sScaleHeight
Else
sScaleHeight = sScaleWidth
End If
.ScaleHeight sScaleHeight, 0, 2
.ScaleWidth sScaleWidth, 0, 2
.top = sTargetTop + (sTargetHeight - .Height) / 2
.Left = sTargetLeft + (sTargetWidth - .Width) / 2
End With

nnext_wks:
Next
.Visible = True
End With
End Sub

 

[C@thy]

Re : Passage d'excel à powerpoint

Merci Steph. En fait, je voulais surtout récupérer les graphiques...

mais c'est un bon début.

Merci à toi, bibises

C@thy

 

[STephane]

Re : Passage d'excel à powerpoint

le code ci-dessous boucle sur les feuilles (toutes les feuilles, donc peut-être que vous voudrez faire des contrôles du type de la feuille supplémentaire), regarde s'il y a un graphique et s'il est lié à un TCD.

ensuite plus qu'à appeler la copie vers Powerpoint.

Sub dodkd()
    Dim wks 'As Worksheet
    Dim linked2TCD As Boolean
    Dim objTCD As PivotTable
    Dim objChart As ChartObject
    Dim strTCDAddress As String

        For Each wks In Sheets
            
            'si la feuille en cours de lecture n'est pas une feuille graphique
            If wks.Type <> "3" Then
                
                'présence de TCD dans la feuille ?
                'ce test est commenté, l'objectif n'étant pas de manipuler le tcd lui-même
                'If wks.PivotTables.count = 0 Then GoTo nnext_wks
                
                'présence de graphique lié à un TCD ? '.... adevelopper
                'If wks.ChartObjects.count = 0 Then GoTo nnext_wks
                
                'présence de graphique avérée, mais lié à un TCD ?
                For Each objChart In wks.ChartObjects
                    If Not objChart.Chart.PivotLayout Is Nothing Then
                        
                        Set objTCD = objChart.Chart.PivotLayout.PivotTable
                        strTCDAddress = objTCD.TableRange2.Address(external:=True)

                        'appeler ici les instructions pour copie vers powerpoint
                        '...
                        '...
                        
                    End If
                Next objChart
            
            'si la feuille en cours de lecture est une feuille graphique
            Else
                wks.Select
                              
                'si condition répondue, alors c'est lié à un TCD
                If Not ActiveSheet.PivotLayout Is Nothing Then
                  Set objTCD = ActiveSheet.PivotLayout.PivotTable
                  strTCDAddress = objTCD.TableRange2.Address(external:=True)
                '  MsgBox strTCDAddress
                  
                  'appeler ici les instructions pour copie vers powerpoint
                  '...
                  '...
                  
                End If
                

            End If
            
            'wks.UsedRange.Copy
           ' Debug.Print wks.Range(wks.PivotTables(1).TableRange2.Address).Address
nnext_wks:
            Next wks
End Sub

 

[C@thy]

Re : Passage d'excel à powerpoint

Un énorme Merci, je vais tester ça.

Mes graphiques ne sont pas sur une feuille à part, mais s'il le faut, je peux les mettre à part.

Bisous

C@thy

 

[STephane]

Re : Passage d'excel à powerpoint

mon code montre comment gérer les 2 cas, à toi d'en extraire ce qu'il faut.
après il te faut encore faire la copie du graphique

 

[C@thy]

Re : Passage d'excel à powerpoint

Yaisse!

Merci pour tout.

Bisous et bonne journée

C@thy

 

[JPIERRA]

Re : Passage d'excel à powerpoint

J'ai presque le même soucis sauf que je veux copier une sélection de cellule dans un slide donné du power point... j'ai essayé de l'adapter mais rien à faire ca bug sur "PptDoc.Slides(2).Shapes.Paste."

Sub CopiedsPPT()
'necessite d'activer la reference Microsoft Powerpoint Object Library
Dim PPT As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim NbShpe As Byte

Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint
PPT.Visible = True
Set PptDoc = PPT.Presentations.Open(Filename:=Excel.ActiveWorkbook.Path & "\New.ppt", ReadOnly:=msoFalse) 'ouverture fichier ppt

Sheets("Opportunités").Select
Range("B19").Copy 'copie plage cellules de la feuille active
PptDoc.Slides(2).Shapes.Paste. 'collage dans le Slide 2 du document Power Point

'compte le nombre de shapes dans le 2eme slide
'le dernier objet inséré correspond à l'index le plus élevé
NbShpe = PptDoc.Slides(2).Shapes.Count

With PptDoc.Slides(2).Shapes(NbShpe)
.Name = "Opportunités" 'personnaliser le nom de l'objet inséré
.Left = 150 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 300 'hauteur image
.Width = 400 'largeur image
End With

PptDoc.Save 'sauvegarder les modifications
PptDoc.Close 'fermer le document ppt
PPT.Quit 'fermer l'application powerPoint
End Sub


Ca ouvre bien le power point...mais ca bug après ..
Si quelqu'un avit une idée pour me débloquer... ca serait génial...

 

[STephane]

Re : Passage d'excel à powerpoint

bonsoir,

là je n'ai même plus une bonne install de word ou excel. ce que tu peux faire, c'est enregistrer une macro dans powerpoint pour vérifier que tu utilises la bonne syntaxe. Il est possible que tu doives sélectionner l'objet avant d'y coller le contenu du presse-papier.

stéphane

 

[JPIERRA]

Re : Passage d'excel à powerpoint

sauf qu'il n'est plus possible d'enregistrer des maceros dans power point 2007

 

[JNP]

Re : Passage d'excel à powerpoint

Bonjour le fil ,
Y a un truc qui m'échappe...

PptDoc.Slides([COLOR=red][B]2[/B][/COLOR]).Shapes.Paste. 'collage dans le Slide [COLOR=red][B]2[/B][/COLOR] du document Power Point

Ton PPT est un nouveau document, donc avec un seul slide. Comment veux-tu copier quelque chose sur le 2ème, sans avoir rajouté un slide ?
Bonne journée

 

[JPIERRA]

Re : Passage d'excel à powerpoint

En fait le template du power point est déjà créer je veux juste alimeznter le slide 2 avec la copie de l'excel...

 

[JNP]

Re : Passage d'excel à powerpoint

Re ,
Je n'avais pas vu mais tu as un point de trop dans la ligne

PptDoc.Slides(2).Shapes.Paste[SIZE=5][COLOR=red][B].[/B][/COLOR][/SIZE] 'collage dans le Slide 2 du document Power Point

A +

 

[JNP]

Re : Passage d'excel à powerpoint

Re ,
Effictivement, j'ai un message d'erreur comme quoi le presse papier est vide, ou qu'il n'est pas au bon format ...
Je suis pas sûr de pouvoir t'aider, désolé ...
Bon courage

 

[JPIERRA]

Re : Passage d'excel à powerpoint

je l'ai corrigé mais ca bug toujours
je l'ai bien dans le presse papier..mais le paste fonctionne pas...