Copier des graphiques Excel dans des emplacements dans PowerPoint

Question

À partir d'Excel, je dois ouvrir un modèle PowerPoint, parcourir chaque diapositive et utiliser des données dans le champ de texte de remplacement des espaces réservés, les faire correspondre à un graphique dans Excel et le copier emplacement dans la diapositive PowerPoint. Après la recherche, j'ai trouvé du code, que j'ai modifié pour atteindre mon objectif. Il travaille dans Win7 Enterprise, mais quand je lance ce même code dans Win10 Enterprise, je reçois l'erreur suivante:

System Error &H800706BE (-2147023170). The remote procedure call failed. 

Ci-dessous mon code, toute aide dans ce que je peux faire mal ou ce qui peut avoir changé dans Win10 qui cause mon problème serait grandement apprécié. Je cours Office 365 ProPlus.

Public Sub QBR_Deck() 

    '# 
    '# Set reference to 'Microsoft PowerPoint <current version> Object Library' in the VBE via Tools > References... 
    '# 

    '# 
    '# Declare variables 
    '# 
    Dim app_PowerPoint As PowerPoint.Application 
    Dim ppt_Presentation As PowerPoint.Presentation 
    Dim obj_PPTSlide As PowerPoint.Slide 
    Dim obj_PPTShape As PowerPoint.Shape 

    Dim obj_ExcelChart As Chart 
    Dim obj_ExcelWorksheet As Worksheet 
    Dim obj_ExcelObject As ListObject 

    Dim lng_i As Long 
    Dim var_Parameters As Variant 

    Dim str_PPTTemplatePath As String 

    '# 
    '# Allow user to select PPT template 
    '# Set path to same location as spreadsheet 
    '# 
    str_PPTTemplatePath = Application.GetOpenFilename(Title:="PowerPoint Template") 
    If str_PPTTemplatePath = "False" Then Exit Sub 

    '# 
    '# Get the PowerPoint Application object 
    '# 
    Set app_PowerPoint = CreateObject("PowerPoint.Application") 
    app_PowerPoint.Visible = msoTrue 
    Set ppt_Presentation = app_PowerPoint.Presentations.Open(str_PPTTemplatePath, untitled:=msoTrue) 

    '# 
    '# Review each slide and each shape on slide 
    '# 
    For Each obj_PPTSlide In ppt_Presentation.Slides 
     For Each obj_PPTShape In obj_PPTSlide.Shapes 

      '# 
      '# Determine when target shapes are located 
      '# Examine Alternative Text in PPT 
      '# Text for objects, will be in this format: @REPLACE|XLS_<chart_name>|PPT_<shape_Name> 
      '# 
      If Left$(obj_PPTShape.AlternativeText, 8) = "@REPLACE" Then 
       var_Parameters = Split(obj_PPTShape.AlternativeText, "|") 

       For Each obj_ExcelWorksheet In ActiveWorkbook.Worksheets 
        '# 
        '# Look at each chart on each worksheet 
        '# Use the Alternative Text to match each chart to the appropriate slide 
        '# Copy and paste onto slide 
        '# 
        For lng_i = obj_ExcelWorksheet.ChartObjects.Count To 1 Step -1 
         If obj_ExcelWorksheet.ChartObjects(lng_i).Name = var_Parameters(1) Then 
          obj_PPTSlide.Select 
          Set obj_ExcelChart = obj_ExcelWorksheet.ChartObjects(lng_i).Chart 
          obj_ExcelChart.ChartArea.Copy 
          app_PowerPoint.Activate 
          obj_PPTShape.Select 
          app_PowerPoint.Windows(1).View.Paste 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Left = obj_PPTShape.Left 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Top = obj_PPTShape.Top 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Height = obj_PPTShape.Height 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Width = obj_PPTShape.Width 
          obj_PPTShape.Delete 
         End If 
        Next lng_i 

       Next obj_ExcelWorksheet 

      End If 'Alternative Text not in expected format 
     Next obj_PPTShape 
    Next obj_PPTSlide 

    '# 
    '# Clean up on the way out 
    '# 
    Set ppt_Presentation = Nothing 
    Set app_PowerPoint = Nothing 

End Sub 

Answer 1

Office 2016 Pro Plus, Windows 10 (pas Office 365 mais ne devrait pas avoir d'importance).

Je remarque que lorsque vous utilisez For Each obj_PPTShape In obj_PPTSlide.Shapes, puis supprimez la forme, il détruit la boucle. La deuxième fois à travers la boucle, il pense toujours à la première forme, qui a été supprimée.

J'ai donc introduit un compteur de formes, et j'ai commencé à partir de obj_PPTSlide.Shapes.Count et j'ai travaillé en arrière (ce que vous n'aviez pas vraiment besoin de faire avec les graphiques sur les diapos Excel, BTW). J'ai également inséré Exit For juste après la suppression de la forme, de sorte que vous ne gardez pas en boucle dans les graphiques et ne pouvez pas trouver la forme que vous avez supprimé. Ce n'est peut-être pas un problème pour vous, mais lorsque j'ai copié mon premier graphique pour en faire une seconde et changé le nom du graphique, le nouveau nom n'a pas pris la première fois.

Alors, voici le code légèrement modifié:

Public Sub QBR_Deck() 

    '# 
    '# Set reference to 'Microsoft PowerPoint <current version> Object Library' in the VBE via Tools > References... 
    '# 

    '# 
    '# Declare variables 
    '# 
    Dim app_PowerPoint As PowerPoint.Application 
    Dim ppt_Presentation As PowerPoint.Presentation 
    Dim obj_PPTSlide As PowerPoint.Slide 
    Dim obj_PPTShape As PowerPoint.Shape 

    Dim obj_ExcelChart As Chart 
    Dim obj_ExcelWorksheet As Worksheet 
    Dim obj_ExcelObject As ListObject 

    Dim lng_i As Long 
    Dim shp_i As Long 
    Dim var_Parameters As Variant 

    Dim str_PPTTemplatePath As String 

    '# 
    '# Allow user to select PPT template 
    '# Set path to same location as spreadsheet 
    '# 
    str_PPTTemplatePath = Application.GetOpenFilename(Title:="PowerPoint Template") 
    If str_PPTTemplatePath = "False" Then Exit Sub 

    '# 
    '# Get the PowerPoint Application object 
    '# 
    Set app_PowerPoint = CreateObject("PowerPoint.Application") 
    app_PowerPoint.Visible = msoTrue 
    Set ppt_Presentation = app_PowerPoint.Presentations.Open(str_PPTTemplatePath, untitled:=msoTrue) 

    '# 
    '# Review each slide and each shape on slide 
    '# 
    For Each obj_PPTSlide In ppt_Presentation.Slides 
     For shp_i = obj_PPTSlide.Shapes.Count To 1 Step -1 
      Set obj_PPTShape = obj_PPTSlide.Shapes(shp_i) 

      '# 
      '# Determine when target shapes are located 
      '# Examine Alternative Text in PPT 
      '# Text for objects, will be in this format: @REPLACE|XLS_<chart_name>|PPT_<shape_Name> 
      '# 
      If Left$(obj_PPTShape.AlternativeText, 8) = "@REPLACE" Then 
       var_Parameters = Split(obj_PPTShape.AlternativeText, "|") 

       For Each obj_ExcelWorksheet In ActiveWorkbook.Worksheets 
        '# 
        '# Look at each chart on each worksheet 
        '# Use the Alternative Text to match each chart to the appropriate slide 
        '# Copy and paste onto slide 
        '# 
        For lng_i = obj_ExcelWorksheet.ChartObjects.Count To 1 Step -1 
         If obj_ExcelWorksheet.ChartObjects(lng_i).Name = var_Parameters(1) Then 
          obj_PPTSlide.Select 
          Set obj_ExcelChart = obj_ExcelWorksheet.ChartObjects(lng_i).Chart 
          obj_ExcelChart.ChartArea.Copy 
          ''app_PowerPoint.Activate '''' unnecessary 
          ''obj_PPTShape.Select '''' unnecessary 
          app_PowerPoint.Windows(1).View.Paste 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Left = obj_PPTShape.Left 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Top = obj_PPTShape.Top 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Height = obj_PPTShape.Height 
          app_PowerPoint.Windows(1).Selection.ShapeRange.Width = obj_PPTShape.Width 
          obj_PPTShape.Delete 
          Exit For 
         End If 
        Next lng_i 

       Next obj_ExcelWorksheet 

      End If 'Alternative Text not in expected format 
     Next shp_i 
    Next obj_PPTSlide 

    '# 
    '# Clean up on the way out 
    '# 
    Set ppt_Presentation = Nothing 
    Set app_PowerPoint = Nothing 

End Sub 

Quand je fais cela, j'utilise souvent une table sur une feuille de calcul dans Excel et les listes de table chaque élément à copier et coller: source (nom de la feuille et nom de diagramme ou adresse de plage), cible (numéro de diapositive, nom de forme ou simplement position et taille), titre de diapositive si désiré, etc. Je trouve qu'il est plus facile de conserver toutes les informations au même endroit, le classeur Excel plutôt que pour aller dans PowerPoint et muck avec le texte Alt (et vous n'avez même pas utilisé le nom de forme PowerPoint, qui est uniquement accessible via VBA). Bien que je n'ai jamais utilisé le texte de l'Alt, et peut-être que cela rend les choses plus faciles que la façon dont j'ai lutté.