Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　PowerPointのスライドに埋め込みグラフを貼り付ける
'
'  Copyright(C) 2000 Sunago
'
'　　PowerPointの新規プレゼンテーションにアクティブシートの
'　埋め込みグラフの数だけスライドを作成し、貼り付けます。
'　貼りついたグラフは位置、サイズが調整されていないので、
'  マクロ実行後、PowerPointを使って適切な位置、サイズに
'  調整してください。
'
'　※このマクロを実行にはPowerPoint97以降が必要です。

Option Explicit

Sub Macro1()
Dim objApp As Object
Dim objSlide As Object
Dim objChart As ChartObject
Dim n

'作成するプレゼンテーションの形式を設定する
Const ppLayoutTextAndChart = 5  '標準レイアウトの５番目

    Set objApp = CreateObject("PowerPoint.Application")
    With objApp
    .Presentations.Add
    For n = 1 To Worksheets("Sheet1").ChartObjects.Count
        With .Presentations(1).Slides
            Set objSlide = .Add(.Count + 1, ppLayoutTextAndChart)
            '埋め込みグラフをクリップボードへコピーする
            Worksheets("Sheet1").ChartObjects(n).Copy
            'クリックボートを図形として貼り付ける
            objSlide.Shapes.Paste
            Set objSlide = Nothing
        End With
    Next
    '貼り付け完了後、PowerPointを表示する
    .Visible = True
    End With
    Set objApp = Nothing
End Sub