PowerPointで選択したExcelチャートをPowerPointの場所にコピーする

Question

Excelから、PowerPointテンプレートを開き、各スライドを歩き、プレースホルダの代替テキストフィールドのデータを使用してExcelのチャートにマッチさせ、 PowerPointスライド内の場所。

検索した後、目標を達成するために修正したコードが見つかりました。それはwin7の企業で動作しますが、私はWin10 Enterpriseでこれと同じ正確なコードを実行すると、私は次のエラーを取得する：

以下

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

は私のコード、私が間違っていることができるものではどのような援助やどのような変更されている可能性があります私の問題を引き起こしているWin10では、大いに感謝しています。私は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（Office 365ではなく、問題ありません）。

For Each obj_PPTShape In obj_PPTSlide.Shapesを使用してシェイプを削除すると、ループが破棄されることがあります。ループを2度目にしても、それは削除された最初の形をまだ考えています。

シェイプカウンターを導入し、obj_PPTSlide.Shapes.Countから開始して、後ろ向きに作業しました（これは、ExcelスライドのチャートBTWで実際には必要ありませんでした）。また、図形を削除した直後にExit Forを挿入したので、グラフをループしていないので、削除した図形が見つからないことがあります。これはあなたにとっては問題ではないかもしれませんが、最初のチャートをコピーして1秒後にチャート名を変更したとき、新しい名前は初めてとは限りませんでした。私はこれを行うと、私は多くの場合、Excelのワークシート上のテーブルを使用

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 

、およびテーブルのリストの各項目をコピーして貼り付ける：

は、だからここに微調整コードのソース（シート名とチャートの名前や範囲のアドレス）、ターゲット（スライド番号、シェイプの名前、または単純な位置とサイズのパラメータ）、スライドのタイトルなどがあります。私は、すべての情報を1つの場所、Excelワークブックに保存する方がPowerPointに入り、Altのテキストで悩まされていました（あなたはVBA経由でのみアクセス可能なPowerPointのシェイプ名を使用していませんでした）。私はAltのテキストを使ったことは一度もありませんでしたが、おそらくこれは私が苦労したやり方より簡単です。