Sub PowerPointTest()
    Dim ppApp As PowerPoint.Application
    Dim ppPrt As PowerPoint.Presentation
    Dim ppSld As PowerPoint.Slide
    Dim ppShape As PowerPoint.Shape 'グラフのタイトルを入力するシェイプ用
    Dim todoufuken As String
    Dim gyo As Long
    
    'Presentation1.pptxを開く（スライドが０枚の状態）
    Set ppApp = New PowerPoint.Application
    Dim path As String
    path = ThisWorkbook.path & "\Presentation1.pptx"
    ppApp.Visible = True
    Set ppPrt = ppApp.Presentations.Open(Filename:=path, ReadOnly:=msoFalse)
    
    
    For gyo = 3 To 49
    
    Worksheets("form").Range("A3").Value = Worksheets("data").Range("A" & gyo).Value
    
    'グラフのタイトル名
    todoufuken = Worksheets("form").Range("B3").Value

    'Excelでグラフを作成する為に範囲を選択、グラフ作成
    Worksheets("form").Range("C1:J3").Select
    Worksheets("form").Shapes.AddChart2(381, xlSunburst).Select

    'グラフのタイトルを非表示
    Worksheets("form").ChartObjects(1).Chart.HasTitle = False
    
    'グラフサイズを調整(ここで調整しないとグラフのデータラベル表示が欠けてしまう)
    Debug.Print Worksheets("form").ChartObjects(1).Chart.PlotArea.Height
    Debug.Print Worksheets("form").ChartObjects(1).Chart.PlotArea.Width
    
    Worksheets("form").ChartObjects(1).Height = 252.262504577637
    Worksheets("form").ChartObjects(1).Width = 407.325050354004
    
    Debug.Print Worksheets("form").ChartObjects(1).Chart.PlotArea.Height
    Debug.Print Worksheets("form").ChartObjects(1).Chart.PlotArea.Width
    
    'グラフをコピー（画像として）
    Worksheets("form").ChartObjects(1).CopyPicture appearance:=xlScreen, Format:=xlPicture

    'グラフを消去（要らないのでグラフは削除しておく）
    Worksheets("form").ChartObjects(1).Delete

    'スライドを作成し、グラフの大きさを調整しスライドの中央に貼り付け
    Dim c As Long    'スライドのカウント用
  
    'スライドの追加
    c = ppPrt.Slides.Count
    Set ppSld = ppPrt.Slides.Add(Index:=c + 1, Layout:=ppLayoutBlank)
    
    'グラフ（シェイプ）の貼り付け
    ppSld.Shapes.Paste
    
    'シェイプの大きさを設定（拡大）
    ppSld.Shapes(1).LockAspectRatio = msoCTrue
    ppSld.Shapes(1).Width = 800
'
    'シェイプの大きさを調査
    Debug.Print ppSld.Shapes(1).Name
    Debug.Print ppSld.Shapes(1).Width
    Debug.Print ppSld.Shapes(1).Height
    
    'スライドの大きさを調査
    Debug.Print ppPrt.PageSetup.SlideWidth
    Debug.Print ppPrt.PageSetup.SlideHeight
    
    'シェイプを中央揃え
    ppSld.Shapes(1).Left = (ppPrt.PageSetup.SlideWidth - ppSld.Shapes(1).Width) / 2
    ppSld.Shapes(1).Top = (ppPrt.PageSetup.SlideHeight - ppSld.Shapes(1).Height) / 2
  
    'グラフのタイトルを入力する為、シェイプを作成し文字を入力
    ppSld.Shapes.AddShape Type:=msoShapeRectangle, Left:=20, Top:=20, Width:=300, Height:=100
    
    Set ppShape = ppSld.Shapes(2)
    ppShape.Fill.Visible = msoFalse
    ppShape.Line.Visible = msoFalse
    ppShape.TextFrame.TextRange.Characters.Font.Size = 60
    ppShape.TextFrame.TextRange.Characters.Font.Color = vbBlack
'   日本語のフォントを設定するので、NameFarEastを使用。"HG 丸ｺﾞｼｯｸ M-PRO"は何故か使えない為明朝体を使用。
    ppShape.TextFrame.TextRange.Font.NameFarEast = "ＭＳ 明朝"
    ppShape.TextFrame.TextRange.Text = todoufuken
    
    Next
    
    ppPrt.Save
    ppPrt.Close
    ppApp.Quit
    
    Set ppShape = Nothing
    Set ppSld = Nothing
    Set ppPrt = Nothing
    Set ppApp = Nothing

End Sub