Hello, I have developped an Excel(2013) tool that generate a PPT Presentation.
My client has Excel 2010 and the tool doesn't work.
I have tried to find the error and it seems that it has to do with the way I paste the tables/charts using the slide.shapes.paste.select code.
So I tried to pastespecial using the enhancedmetafile and it worked but I don't like the format on PowerPoint.
My question is: am I obliged to do this for Excel 2010? or is there a way to paste normally like I do on Excel 2013? Thank you for your help.


Sub GenerationPPT()


Dim pptApp As PowerPoint.Application
Dim pres As PowerPoint.presentation
Dim sld As PowerPoint.Slide
Dim shp As Object
Dim shpPaste As Object
Dim strCheminTempPPT As String
Dim vntParams As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Long
Dim rngSlides As Range
Dim rng As Range
Dim intSlidesCount As Integer
Dim cheminTempPPT As String
Dim cheminDossier As String

Dim blnEE As Boolean
Dim blnSU As Boolean


blnEE = Application.EnableEvents
blnSU = Application.ScreenUpdating
Application.EnableEvents = False
Application.ScreenUpdating = False


'MsgBox Erreur
Set rngSlides = Range(ShParamsPPT.Range("Slide").Offset(1, 1), ShParamsPPT.Range("Slide").Offset(28, 1))
For Each rng In rngSlides
If rng.Value2 = "X" Or rng.Value2 = "Oui" Then intSlidesCount = intSlidesCount + 1
Next

If intSlidesCount = 2 Then
MsgBox ("Veuillez sélectionner au moins un élément à intégrer à la présentation")
GoTo C
End If

'démarrer l'application powerpoint
Set pptApp = New PowerPoint.Application
pptApp.Visible = True

'ouvrir le template
cheminDossier = ThisWorkbook.Path
cheminTempPPT = cheminDossier & fichierTempPPT
Set pres = pptApp.presentations.Open(cheminTempPPT)


'renseigner la date du jour sur le premier slide
Set sld = pres.Slides(1)
sld.Select
Set shp = sld.Shapes("Date")
shp.TextFrame.TextRange.Text = Date

'affecter les données de paramétrage au variant
vntParams = ShParamsPPT.Range("params").Value2

'parcours vertical du tableau paramétrage
For i = 1 To UBound(vntParams, 1)
'affectation du numéro de slide correspondant
Set sld = pres.Slides(vntParams(i, 1))

'test intégration du slide
If vntParams(i, 2) = "Oui" Then GoTo B
If vntParams(i, 2) = "X" Then
'intégration du slide
'parcours horizontal du tableau paramétrage

'test existence d'un élément du slide

For j = 1 To 4
If vntParams(i, 3 + 6 * (j - 1)) <> "" Then
'test inclusion de cet élément dans le slide
If vntParams(i, 5 + 6 * (j - 1)) <> "X" Then
Set shp = sld.Shapes("Obj" & j)
shp.Delete
On Error Resume Next
sld.Shapes("rect" & j).Delete
End If

If vntParams(i, 5 + 6 * (j - 1)) = "X" Then

'définition de l'objet à supprimer
Set shp = sld.Shapes("Obj" & j)

'copie de l'élément correspondant



If vntParams(i, 4 + 6 * (j - 1)) = "Tab" Then ThisWorkbook.Sheets(vntParams(i, 7 + 6 * (j - 1))).Range(vntParams(i, 8 + 6 * (j - 1))).Copy
If vntParams(i, 4 + 6 * (j - 1)) = "Graph" Then ThisWorkbook.Sheets(vntParams(i, 7 + 6 * (j - 1))).ChartObjects(vntParams(i, 8 + 6 * (j - 1))).Chart.ChartArea.Copy


WaitPrecise (4000)

'collage de l'élément correspondant
sld.Select
Set shpPaste = sld.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
'Set shpPaste = sld.Shapes.Paste

'alignement de la taille
With shpPaste
.LockAspectRatio = 0
.Top = shp.Top
.Left = shp.Left
.Width = shp.Width
.Height = shp.Height
End With
'suppression de l'objet
shp.Delete
End If
End If
A: Next j

End If
B: Next i


'suppression des slides que l'utilisateur ne veut pas inclure
k = 0
For i = 1 To UBound(vntParams, 1)
If vntParams(i, 2) = "" Then
k = k + 1
pres.Slides(i + 1 - k).Delete
End If
Next i

'enregistrement

pres.SaveAs Filename:=ThisWorkbook.Path & "\AbbVie_Reporting Naya_" & Day(Date) & Month(Date) & Year(Date) & Hour(Now) & Minute(Now) & ".pptx"
pres.Close
pptApp.Quit

'MsgBox information user
If intSlidesCount > 1 Then MsgBox ("Un fichier PowerPoint comprenant " & intSlidesCount & " slides a été créé dans le dossier.")
If intSlidesCount = 1 Then MsgBox ("Un fichier PowerPoint comprenant " & intSlidesCount & " slide a été créé dans le dossier.")
C:
Application.EnableEvents = blnEE
Application.ScreenUpdating = blnSU
Application.DisplayAlerts = True


End Sub