[[20160522204706]]　『グラフをパワポに貼り付けマクロ』（かぼ）　ページの最後に飛ぶ

『グラフをパワポに貼り付けマクロ』（かぼ）

どなたかお知恵を貸してください。
エクセルの複数シートにそれぞれ「グラフ1」「グラフ2」等の名称のグラフが連番で複数存在しており、
そのグラフを全てマクロでタイトルスライド＋グラフの数のページ数のパワポファイル（テンプレート）に自動貼り付けがしたいです。

自力で下記まで作成してみましたが、「実行」等で一気に動かすとパワポのランダムの1スライドに同じグラフが何重にも重なってしまうだけで希望通りに動きません。
ただし、ステップ実行か下記にコメントとして記載した箇所にブレークポイントを設置してF5で進めると希望通りに動きます。

ステップ実行等せず、「実行」で一気に動くようにすることは可能でしょうか。

Sub グラフ貼り付け()

    Dim filepath As String
    Dim pptApp As Object 'PPTアプリ
    Dim pptPre As Object 'PPTプレゼンテーション
    Dim pptSld As Object 'PPTスライド
    Dim Ws As Worksheet
    Dim p As Long, s As Long, i As Long

    '//ダイアログからパワーポイントファイルを選択する。
    filepath = Application.GetOpenFilename("PowerPoint プレゼンテーション,*.pptx")

    '//ファイル選択されている場合はファイルを開く。
    If filepath <> "False" Then
        Set pptApp = CreateObject("PowerPoint.Application")
        Set pptPre = pptApp.Presentations.Open(Filename:=filepath)
    Else
        MsgBox "処理を中止します"
        Exit Sub
    End If

    '//パワポの2ページ目が貼り付けのスタートとする
    p = 2

    '//1シート目から2シート目まで繰り返し
    For s = 1 To 2

        Set Ws = Sheets(s)

            For i = 1 To Ws.ChartObjects.Count

                Set pptSld = pptPre.Slides(p)

                '//Selectしないとうまくスライドが選択されないことがある
                pptSld.Select

                '//Selectしないとうまくコピーが出来ないことがある
                Ws.ChartObjects("グラフ " & i).Select
                Ws.ChartObjects("グラフ " & i).Copy

                        With pptSld

                        '//この下にブレークポイントで動く
'●
                        pptApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"

                        '//この下にブレークポイントで動く
'●
                            With pptSld.Shapes(pptSld.Shapes.Count)
                                .LockAspectRatio = msoFalse
                                .Top = 100
                                .Left = 20
                                .Width = 420
                                .Height = 270
                            End With

                        End With

                p = p + 1

            Next

    Next

    MsgBox "完了しました"

End Sub

よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows8 ＞

ここのコメント欄が参考になりますか
http://ateitexe.com/powerpoint-paste-datatype/
（マナ） 2016/05/22(日) 22:45

マナさん

大変参考になりました！
お蔭さまでスムーズに動くようになりました。
ありがとうございました。
（かぼ） 2016/05/23(月) 21:55

コメント返信：

[ 一覧(最新更新順) ]

[[20160522204706]] 『グラフをパワポに貼り付けマクロ』（かぼ） ページの最後に飛ぶ

[[20160522204706]]　『グラフをパワポに貼り付けマクロ』（かぼ）　ページの最後に飛ぶ