ExcelシートからPowerpointスライドへのすべてのチャートのコピー

Question

私は担当している月次レポートプレゼンテーションの作成を容易にするためのワークブックを作成しました。ワークブックにはいくつかのデータシートといくつかの処理シートがあり、対応するスライドに貼り付けるために必要なチャートが含まれています。これまでは、PowerPointテンプレートを開き、各Excelシートをループし、どのシート名が数値であるかを識別し、PowerPointテンプレート上の対応するスライドをアクティブにするためのVBAを構築しました。

同様の問題の他の解決策とは異なり、各シート/スライドの形状、量、配置が異なるため、一度に各番号のシートから各スライドにすべてのチャートをコピーしたいと思います。私はたいてい、一度に1つのチャートをコピーしてイメージとして貼り付ける人たちしか見つけませんでした。私にとってはうまくいかないでしょう（私はデータ・ラベルと最終スライド上の位置を微調整する必要があります）。どのように私はそれを達成することができますかについてのヒント？ここで

は私のコードは、これまでのようになります。あなたは、対応するスライドに各シートのチャートオブジェクトを貼り付けることができ、以下の変更されたコードで

Sub CriarSlides() 

Dim pptApp As Powerpoint.Application 
Dim pptPres As Powerpoint.Presentation 
Dim strFileToOpen As Variant 
Dim strFileName As String, Hosp As String 
Dim datawb As Workbook 
Dim xlsCounter As Integer, xlsSlide As Integer 


Set datawb = ThisWorkbook 


strFileToOpen = Application.GetOpenFilename _ 
FileFilter:="Powerpoint Files *.pptx (*.pptx),") 
If strFileToOpen = False Then 
    Exit Sub 
Else 
    Set pptApp = New Powerpoint.Application 
    pptApp.Visible = True 
    pptApp.Presentations.Open Filename:=strFileToOpen, ReadOnly:=msoFalse, Untitled:=msoTrue 
    Set pptPres = pptApp.Presentations(1) 
End If 

For xlsCounter = datawb.Worksheets.Count To 1 Step -1 
    If IsNumeric(datawb.Worksheets(xlsCounter).Name) Then 
     xlsSlide = datawb.Worksheets(xlsCounter).Name 

' This is the problematic part 

     Debug.Print xlsSlide 
    End If 
Next xlsCounter 
End Sub 

Answer 1

：

Sub CriarSlides() 
    Dim pptApp As PowerPoint.Application, pptPres As PowerPoint.Presentation 
    Dim strFileToOpen As Variant, sh As Worksheet, ch As ChartObject 

    strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),") 
    If strFileToOpen = False Then Exit Sub 
    Set pptApp = New PowerPoint.Application 
    pptApp.Visible = True 
    Set pptPres = pptApp.Presentations.Open(fileName:=strFileToOpen, ReadOnly:=msoFalse) 

    For Each sh In ThisWorkbook.Sheets 
     If IsNumeric(sh.name) Then 
      For Each ch In sh.ChartObjects 
       ch.Copy 
       With pptPres.Slides(CLng(sh.name)).Shapes.Paste 
        .Top = ch.Top 
        .Left = ch.Left 
        .Width = ch.Width 
        .Height = ch.Height 
       End With 
      Next 
     End If 
    Next 
End Sub