VBAを使用してExcelチャートをPowerpointに貼り付けよう

Question

Excelシートに表示されているチャートをコピーし、PowerPointに貼り付ける（エクストラシートを貼り付ける）エクセルマクロを作成しようとしています。私が抱えている問題は、それぞれのチャートを別のスライドに貼り付ける方法です。私はこれは私がこれまで持っているものである

構文ですべてを...知らない（それが動作しますが、それ最初のシートにのみペースト）：

Sub graphics3() 

Sheets("Chart1").Select 
ActiveSheet.ChartObjects("Chart1").Activate 
ActiveChart.ChartArea.Copy 
Sheets("Graphs").Select 
range("A1").Select 
ActiveSheet.Paste 
    With ActiveChart.Parent 
    .Height = 425 ' resize 
    .Width = 645 ' resize 
    .Top = 1 ' reposition 
    .Left = 1 ' reposition 
End With 

Dim PPT As Object 
Set PPT = CreateObject("PowerPoint.Application") 
PPT.Visible = True 
PPT.Presentations.Open Filename:="locationwherepptxis" 

Set PPApp = GetObject("Powerpoint.Application") 
Set PPPres = PPApp.activepresentation 
Set PPSlide = PPPres.slides _ 
    (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) 

' Copy chart as a picture 
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _ 
    Format:=xlPicture 

' Paste chart 
PPSlide.Shapes.Paste.Select 

' Align pasted chart 
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 

Answer 1

私は仕事にあなたのファイルの場所を持っていけない考えます私はあなたに従ってグラフ1と呼ばれるシート（中パワーポイントの新しいインスタンスを作成したこと

1. 以下のルーチン（遅延バインディング、ppViewSlideなどの定数を定義するので、必要性）各チャートを通じて
2. ループを添付していると例）
3. その後、

を繰り返し、新しいスライド

ペースト各チャートを追加し、あなたはサイズのためにエクスポートする前に、各チャート画像をフォーマットする必要がありました、またはあなたのデフォルトのグラフのサイズを変更できますか？

Const ppLayoutBlank = 2 
Const ppViewSlide = 1 

Sub ExportChartstoPowerPoint() 
    Dim PPApp As Object 
    Dim chr 
    Set PPApp = CreateObject("PowerPoint.Application") 
    PPApp.Presentations.Add 
    PPApp.ActiveWindow.ViewType = ppViewSlide 
    For Each chr In Sheets("Chart1").ChartObjects 
     PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
     PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count 
     chr.Select 
     ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
     PPApp.ActiveWindow.View.Paste 
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
    Next chr 
    PPApp.Visible = True 
End Sub 

Answer 2

機能付きコードPPT

にエクセルから

Option Base 1 
Public ppApp As PowerPoint.Application 

Sub CopyChart() 

Dim wb As Workbook, ws As Worksheet 
Dim oPPTPres As PowerPoint.Presentation 
Dim myPPT As String 
myPPT = "C:\LearnPPT\MyPresentation2.pptx" 

Set ppApp = CreateObject("PowerPoint.Application") 
'Set oPPTPres = ppApp.Presentations("MyPresentation2.pptx") 
Set oPPTPres = ppApp.Presentations.Open(Filename:=myPPT) 
ppApp.Visible = True 
Set wb = ThisWorkbook 
Set ws = wb.Sheets(1) 

i = 1 

For Each shp In ws.Shapes 

    strShapename = "C" & i 
    ws.Shapes(shp.Name).Name = strShapename 
    'shpArray.Add (shp) 
    i = i + 1 

Next shp 

Call Plot6Chart(oPPTPres, 2, ws.Shapes(1), ws.Shapes(2), ws.Shapes(3), ws.Shapes(4), ws.Shapes(5), ws.Shapes(6)) 

End Sub 
Function Plot6Chart(pPres As Presentation, SlideNo As Long, ParamArray cCharts()) 

Dim oSh As Shape 
Dim pSlide As Slide 
Dim lLeft As Long, lTop As Long 

Application.CutCopyMode = False 
Set pSlide = pPres.Slides(SlideNo) 

For i = 0 To UBound(cCharts) 

    cCharts(i).Copy 
    ppApp.ActiveWindow.View.GotoSlide SlideNo 
    pSlide.Shapes.Paste 
    Application.CutCopyMode = False 


    If i = 0 Then ' 1st Chart 
     lTop = 0 
     lLeft = 0 
    ElseIf i = 1 Then ' 2ndChart 
     lLeft = lLeft + 240 
    ElseIf i = 2 Then ' 3rd Chart 
     lLeft = lLeft + 240 
    ElseIf i = 3 Then ' 4th Chart 
     lTop = lTop + 270 
     lLeft = 0 
    ElseIf i = 4 Then ' 5th Chart 
     lLeft = lLeft + 240 
    ElseIf i = 5 Then ' 6th Chart 
     lLeft = lLeft + 240 
    End If 

    pSlide.Shapes(cCharts(i).Name).Left = lLeft 
    pSlide.Shapes(cCharts(i).Name).Top = lTop 

Next i 

Set oSh = Nothing 
Set pSlide = Nothing 
Set oPPTPres = Nothing 
Set ppApp = Nothing 
Set pPres = Nothing 

End Function