エクセルからパワーポイントにコピー＆ペーストするときのグラフの形や位置を調整したい

Question

VBAのマクロを使ってエクセルからパワーポイントへグラフをコピー＆ペーストしていますが、パワーポイント内のグラフの形状と配置は、私は、ページの中央にグラフを移動したいと私は、貼り付けられたものより小さい形が必要です。

使用してコードイムは、次のとおりです。

Sub CreatePowerPoint() 
 

 
'Add a reference to the Microsoft PowerPoint Library by: 
 
    '1. Go to Tools in the VBA menu 
 
    '2. Click on Reference 
 
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay 
 
    
 
    'First we declare the variables we will be using 
 
     Dim newPowerPoint As PowerPoint.Application 
 
     Dim activeSlide As PowerPoint.slide 
 
     Dim cht As Excel.ChartObject 
 
     
 
    'Look for existing instance 
 
     On Error Resume Next 
 
     Set newPowerPoint = GetObject(, "PowerPoint.Application") 
 
     On Error GoTo 0 
 
     
 
    'Let's create a new PowerPoint 
 
     If newPowerPoint Is Nothing Then 
 
      Set newPowerPoint = New PowerPoint.Application 
 
     End If 
 
    'Make a presentation in PowerPoint 
 
     If newPowerPoint.Presentations.Count = 0 Then 
 
      newPowerPoint.Presentations.Add 
 
     End If 
 
     
 
    'Show the PowerPoint 
 
     newPowerPoint.Visible = True 
 
    
 
    'Loop through each chart in the Excel worksheet and paste them into the PowerPoint 
 
     For Each cht In ActiveSheet.ChartObjects 
 
     
 
     'Add a new slide where we will paste the chart 
 
      newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText 
 
      newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count 
 
      Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 
 
       
 
     'Copy the chart and paste it into the PowerPoint as a Metafile Picture 
 
      cht.Select 
 
      ActiveChart.ChartArea.Copy 
 
      activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select 
 
      
 
    ' 'Set the title of the slide the same as the title of the chart 
 
      activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text 
 
     
 
      
 
     'Adjust the positioning of the Chart on Powerpoint Slide 
 
      newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15 
 
      newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125 
 
     
 
      activeSlide.Shapes(2).Width = 200 
 
      activeSlide.Shapes(2).Left = 505 
 
      
 
     Next 
 
     
 
    AppActivate ("Microsoft PowerPoint") 
 
    Set activeSlide = Nothing 
 
    Set newPowerPoint = Nothing 
 
     
 
End Sub

Answer 1

ここで行く、これはあなたが軌道に乗る必要があります。私は " - CHANGES MADE"とコメントしました。ここで私はいくつかの変更を加えました。コード内のサイズを調整することができ、自動的に中央に配置されます。

Sub CreatePowerPoint() 

'Add a reference to the Microsoft PowerPoint Library by: 
'1. Go to Tools in the VBA menu 
'2. Click on Reference 
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay 

'First we declare the variables we will be using 
    Dim newPowerPoint As PowerPoint.Application 
    Dim activeSlide As PowerPoint.slide 
    Dim cht As Excel.ChartObject 

'Look for existing instance 
    On Error Resume Next 
    Set newPowerPoint = GetObject(, "PowerPoint.Application") 
    On Error GoTo 0 

'Let's create a new PowerPoint 
    If newPowerPoint Is Nothing Then 
     Set newPowerPoint = New PowerPoint.Application 
    End If 
'Make a presentation in PowerPoint 
    If newPowerPoint.Presentations.Count = 0 Then 
     newPowerPoint.Presentations.Add 
    End If 

'Show the PowerPoint 
    newPowerPoint.Visible = True 

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint 
    For Each cht In ActiveSheet.ChartObjects 

    'Add a new slide where we will paste the chart 
     newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText 
     newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count 
     Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 

    'Copy the chart and paste it into the PowerPoint as a Metafile Picture -CHANGES MADE 
     cht.Select 
     ActiveChart.ChartArea.Copy 

    'CHANGES MADE 
     Dim obj As Object 
     Set obj = activeSlide.Shapes.Paste 

    'Set the title of the slide the same as the title of the chart 
     activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text 

    'Adjust the positioning of the Chart on Powerpoint Slide -CHANGES MADE 
     obj.Width = 500 'Adjust width and height here 
     obj.Height = 300 
     With newPowerPoint.ActiveWindow.Presentation.PageSetup 
      obj.Left = (.SlideWidth \ 2) - (obj.Width \ 2) 
      obj.Top = (.SlideHeight \ 2) - (obj.Height \ 2) 
     End With 

    Next 

AppActivate ("Microsoft PowerPoint") 
Set activeSlide = Nothing 
Set newPowerPoint = Nothing 

End Sub