アプリ開発ときどきアウトドア

主にJavaを使ったアプリ開発やトラブルシューティング等のノウハウ、キャンプや登山の紹介や体験談など。

1. システムエンジニアリング Excel/Word

ExcelからPowerPointへの図表貼り付けVBA

投稿日:2019年12月15日 更新日:


パフォーマンスモニタの監視データ(blg)に基づいてPowerPointで報告用のレポートを作成する必要がありました。パフォーマンスログのデータをCSVに変換してExcelに取り込んでグラフを作成し、そのグラフをPowerPointに貼り付ける形で実現しようと考えました。
ここでは、Excelの図表をPowerPointに貼り付ける作業をVBAで実現します。
ちなみにPowerShellでも実現できるのですが2019年時点ではVBAを推奨します。詳細はこちらをご覧ください。

概要

Excel上のグラフや表領域をPowerPointの各スライドに貼り付けるExcel VBAを紹介します。

前提

  • パフォーマンスモニタのログファイルをExcelにインポートしてグラフや表を作成する処理については、ここでは扱いません。(別途記事を投稿予定です。)
  • Microsoft Excel 2013/PowerPoint2013、Excel 2010/PowerPoint 2010を対象とします。それ以外の環境では動作確認できていません。
  • コピー元となるExcelファイルのグラフや表、コピー先となるPowerPointファイル上の表等を事前に用意している前提です。
  • 技術検証のためのサンプルであり、業務で使用する場合は適宜変更してください。

考察

検証を通して理解したことや気づいたことです。

  • Excel上のグラフオブジェクトは、”Worksheet.ChartObjects(name)”で参照できます。引数にはインデックスか名前を指定できます。Excelでグラフオブジェクト等に名前を設定する場合、[ホーム]タブの[検索と選択]-[オブジェクトの選択と表示]から行います。
  • PowerPoint上の表オブジェクトは、”Slide.Shapes(name).Table.Cell(row, col)”で参照できます。同様に名前を設定する場合、[ホーム]タブの[選択]-[オブジェクトの選択と表示]から行います。
  • Excelの図表をコピーし、PowerPointに張り付ける場合、Windowsのクリップボードを中継することになります。Excel VBAでブックやシート等のExcel上の操作を行う場合は同期処理(個々の操作が完了してから次の処理に進む)となりますが、Excelからの「クリップボード操作」「PowerPoint操作」は非同期処理(それぞれの操作が完了する前に次の処理に進む)となります。そのため、単純にExcelからコピーしてPowerPointに貼り付けを行うと、Excelからクリップボードへの図表コピーが完了する前に、クリップボードからPowerPointへの貼り付けが開始され、期待した通りに動作しない場合があります。
  • 個々の操作が完了したかの確認を行えるAPIは存在せず、独自に回避策の実装が必要となります。一番簡単で確実なのはスリープすることです。ただし、この辺の事象の発生はPowerPointのバージョンで異なりますが、新しいバージョンの方が安定している感がします。
    手段 概要
    コピー後の待機時間を設ける 確実にコピーが完了できるよう、コピー開始後に所定時間待機する方法です。
    待機時間に比例して貼り付けの成功率は上がりますが、トータルの処理時間が長くなります。また、環境や処理対象データによって時間の調整が必要となります。
    貼り付けをリトライする 貼り付け失敗時に再度貼り付けする方法です。
    コピーと貼り付け操作は環境依存のようで、PowerPoint2013では有効でしたが、PowerPoint2010では貼り付け失敗時にコピーデータが失われている状態でありリトライに意味がありませんでした。(コピーからリトライすればいいのかもしれません。)
    独自に値を設定する
    (コピペは断念)
    貼り付けようとしている値をプログラムで値設定する方法です。
    例えば表のセル領域をコピーするのではなく、セル個別の値を取得し、貼り付け先のセル個別に値を設定するイメージです。クリップボードを使わないので確実ですが、コード量が増えることや、複雑な値設定は困難です。
  • 待機時間を設ける場合、VBA以外の動作がフリーズしてしまうので、前後にDoEventsを実行しましょう。DoEventsを実行することで、OS側で管理している他のアプリのイベントを処理できます。(DoEventsがないと、スリープしてもクリップボードへのコピーが開始されない可能性があるため。)
  • PowerPointへの図の貼り付けのために”CommandBars.ExecuteMso(idMso)”を使用しています。これはリボン等のUI上のコマンドを実行するためのコマンドです。引数(idMso)には様々なものを指定可能であり、詳細はこちらで確認できます。

サンプルの説明

サンプルの構成

今回のサンプルは、VBAを格納するCopyMacro.xlsm、コピー元の図表を格納するグラフテンプレート.xlsx、図表の貼り付け先となるサンプルレポート.pptx、という3つのファイルで構成しています。
CopyMacro.xlsmのVBAを実行すると、グラフテンプレート上の各シートにある図表をコピーし、サンプルレポート上の各スライドに順番に張り付けていきます。本来であれば、数十個の図表をレポートに張り付ける必要があったのですが、今回は検証目的であるため、グラフテンプレート上の3シート分の図表を、サンプルレポートの10スライドに貼り付けます。(Excelの最初の2つの図表は、PowerPointのスライド2,3に貼り付けます。Excelの3つ目の図表を、PowerPointのスライド4以降に繰り返し貼り付けます。)

これらのファイルはこちらからダウンロードできます。

ファイル名 説明
CopyMacro.xlsm 下記サンプルコードを含むマクロファイルです。
グラフテンプレート.xlsx サンプルのグラフと表(コピー元)です。
シート”01″に図表、その元となるデータが”01data”シートに定義されています。同様に、”02″/”02data”, “0X”/”0Xdata”シートを格納します。
コピー元となるグラフ(chart)を識別できるよう、[オブジェクトの選択と表示]を使って各シートの対象グラフに”graph”という名前を設定しています。
サンプルレポート.pptx サンプルのレポート(コピー先)です。
貼り付け先となる表を識別できるよう、[オブジェクトの選択と表示]を使って各スライドの対象表に”main_table”という名前を設定しています。

実行方法

CopyMacro.xlsmを開き、[開発タブ]-[Visual Basic]をクリックします。
起動した[Microsoft Visual Basic for Applications]ウインドウで、再生ボタンをクリックします。
マクロ名でCopyXlsToPptを選択し、[実行]をクリックします。

サンプルプログラム

サンプルプログラムは次の通りです。

  • PowerPoint操作、クリップボード操作(DataObject)を行うためにVBAの参照設定でDLLを追加しています。クリップボード操作を行うためのライブラリは参照設定の一覧から選択できないため、”C:\Windows\System32\FM20.dll”を参照しています。
  • Sleep関数はkernel32のものを使用しています。(処理時間がかかるDoEventsを繰り返し実行して待機する方法もありますが、今回はSleep関数を使うことにしました。)
  • 表領域の貼り付けに関して、PowerPoint2013では”PowerPoint.Application.CommandBars.ExecuteMso”でさくさく貼り付けできたのですが、PowerPoint2010での最初の貼り付けに5秒程かかりました。そのため、PowerPoint2013環境では”PowerPoint.Application.ActiveWindow.View.PasteSpecial”を使用しています。(二つのコマンドで若干貼り付けの書式が違うようですが、そこは割り切りました。)
  • グラフ貼り付けで使っているPasteSpecial()のリトライ処理は、PowerPoint2013でしか確認できていません。PowerPoint2010環境では、コピー元が不正となるためリトライしても正常に貼り付けできません。
  • PowerPoint系のAPIから返却されるオブジェクトを代入時の型不一致エラーがでる場合があります。返却値を入れるDim宣言では、”Dim shape As PowerPoint.Shape”等のようにPowerPointのクラスであることを宣言した方が安全です。
  • PowerPoint張り付き先のグラフ座標はPowerPointで確認した結果を入力できるようcm単位にしています。
  • 待ち時間(PHASE_INTERVAL, OPE_INTERVAL, COPY_INTERVAL)は、実行環境や対象ファイルに応じて、適宜調整してください。
Option Explicit

'追加が必要な参照設定([ツール]->[参照設定]):
'・"Microsoft PowerPoint XX.X Object Library"
' →PowerPoint操作のため。
'・"Microsoft Forms X.X Object Library"(FM20.dllを参照)
' →クリップボード操作(DataObject)のため。

'コピー元のExcel上の図表識別情報
Const XLS_GRAPH_NAME As String = "graph"
Const XLS_COPY_RG As String = "B26:D26"

'コピー先のPowerPoint上の図表識別情報
Const PPT_GRAPH_NAME As String = "main_graph"
Const PPT_GRAPH_TOP As Double = 4.98    '[cm] ←PPT上の表記に合わせた
Const PPT_GRAPH_LEFT As Double = 2.52   '[cm] ←PPT上の表記に合わせた
Const PPT_TABLE_NAME As String = "main_table"
Const PPT_TABLE_ROW_IDX As Integer = 2
Const PPT_TABLE_COL_IDX As Integer = 2

'PowerPoint操作時の待機時間
Const PHASE_INTERVAL As Integer = (3 * 1000)    '[ms]
Const OPE_INTERVAL As Integer = (0.1 * 1000)    '[ms]
Const COPY_INTERVAL As Integer = (1 * 1000)     '[ms]

'貼り付け失敗時のリトライ回数
Const RETRY_COUNT As Integer = 3

'Sleep関数を使用するため
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)


'ExcelからPowerPointに図表をコピーする。
Sub CopyXlsToPpt()

    Dim myfolder As String
    myfolder = ThisWorkbook.Path

    Application.Visible = True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    Dim ppt As New PowerPoint.Application
    ppt.Visible = msoTrue
    Dim pres As PowerPoint.Presentation
    Set pres = ppt.Presentations.Open(myfolder & "\サンプルレポート.pptx", msoFalse)
 
    Dim book As Workbook
    Set book = Workbooks.Open(myfolder & "\グラフテンプレート.xlsx", 0, True)
    
    '起動が確実に完了後から処理開始
    WaitPhaseInterval
    
    Dim st As Worksheet
    Dim sl As PowerPoint.slide
    
    '項目A ****************************************
    Set st = book.Sheets("01")
    Set sl = pres.Slides(2)
    sl.Select       'コピー先が表示されている必要あり(80048240エラー回避)
    CopyTable st, ppt, sl
    CopyGraph st, sl

    '項目B ****************************************
    Set st = book.Sheets("02")
    Set sl = pres.Slides(3)
    sl.Select
    CopyTable st, ppt, sl
    CopyGraph st, sl

    '項目X(テスト用繰り返し) **********************
    Dim i As Integer
    For i = 4 To 10
        Set st = book.Sheets("0X")
        Set sl = pres.Slides(i)
        sl.Select
        CopyTable st, ppt, sl
        CopyGraph st, sl
    Next
    
    'コピー前にExcelが終了しないよう待機
    '(意図しない形式で貼り付けされる場合があるため。)
    WaitPhaseInterval
    
    book.Close
    'pres.Close
    'ppt.Quit

End Sub

'表データをコピーする。
Sub CopyTable(st As Worksheet, ppt As PowerPoint.Application, sl As PowerPoint.slide)

    ClipboardClear

    'copy table
    Dim copyRange As Range
    Set copyRange = st.Range(XLS_COPY_RG)
    copyRange.Copy
    WaitCopyInterval
    
    'paste table
    Dim pasteTableShape As PowerPoint.Shape
    Dim pasteTable As PowerPoint.Table
    Dim pasteCell As PowerPoint.Cell
    Set pasteTableShape = sl.Shapes(PPT_TABLE_NAME)
    pasteTableShape.Select
    Set pasteTable = pasteTableShape.Table
    Set pasteCell = pasteTable.Cell(PPT_TABLE_ROW_IDX, PPT_TABLE_COL_IDX)
    pasteCell.Select
    
    'PowerPoint2013用の貼り付け
    '(画面上の貼り付けボタンを操作)
    'ppt.CommandBars.ExecuteMso "PasteExcelTableDestinationTableStyle"
    
    'PowerPoint2010用の貼り付け
    '(PowerPoint2010では"ExecuteMso"の遅延が大きくエラーになりやすいため。)
    ppt.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
    
    '(参考)確実に処理したい場合、次のようにセル個別に値を代入する方法もある
    'pasteCell.Shape.TextFrame.TextRange.Text = 100
    
    WaitOpeInterval

End Sub

'グラフをコピーする。
Sub CopyGraph(st As Worksheet, sl As PowerPoint.slide)

    ClipboardClear

    'Excel上のグラフをコピー
    Dim copyChart As ChartObject
    Set copyChart = st.ChartObjects(XLS_GRAPH_NAME)
    copyChart.Select
    copyChart.Copy
    WaitCopyInterval
    
    'PowerPointにグラフを貼り付け
    '(PowerPoint2010環境では、PasteSpecialエラー時にクリップボードの
    'データが不正となりリトライできない。)
    Dim pasteFigure As PowerPoint.ShapeRange
    Dim i As Integer
    On Error Resume Next
    For i = 1 To RETRY_COUNT
        Err.Clear
        Set pasteFigure = sl.Shapes.PasteSpecial(ppPastePNG)
        If Err.Number = 0 Then
            Exit For
        End If
        Debug.Print "PasteSpecial(" & i & "): " & Hex(Err.Number) & ": " & Err.Description
        Set pasteFigure = Nothing
        If i < RETRY_COUNT Then
            WaitCopyInterval
        End If
    Next
    On Error GoTo 0
    If pasteFigure Is Nothing Then
        Err.Raise Number:=513, Description:="図の貼り付けリトライで失敗しました。"
    End If
    pasteFigure.Name = PPT_GRAPH_NAME
    pasteFigure.Top = Application.CentimetersToPoints(PPT_GRAPH_TOP)
    pasteFigure.Left = Application.CentimetersToPoints(PPT_GRAPH_LEFT)

    WaitOpeInterval

End Sub

'初期化インターバル
'(起動/終了時の比較的長い待機時間用)
Sub WaitPhaseInterval()
    DoEvents
    Sleep PHASE_INTERVAL
    DoEvents
End Sub

'操作インターバル
'(各処理間の待機時間用)
Sub WaitOpeInterval()
    DoEvents
    Sleep OPE_INTERVAL
    DoEvents
End Sub

'コピーインターバル
'(コピー直後用の待機時間用)
Sub WaitCopyInterval()
    DoEvents
    Sleep COPY_INTERVAL
    DoEvents
End Sub

'クリップボードの内容をクリア
Sub ClipboardClear()
    DoEvents
    Dim cb As New DataObject
    cb.SetText Empty
    cb.PutInClipboard
    DoEvents
End Sub


(adsbygoogle = window.adsbygoogle || []).push({});


(adsbygoogle = window.adsbygoogle || []).push({});

-1. システムエンジニアリング, Excel/Word

執筆者:

関連記事

ASP.NET Core: IHttpClientFactoryのサンプル

前回の記事でIHttpClientFactoryの使用方法を説明しました。 ここでは、サンプルを使用した具体的な使用方法を説明します。 前提 マイクロソフトが推奨するIHttpClientFactor …

マスタデータ生成ツール

開発や結合試験、本番環境等で使用するマスタデータをExcelで管理することがあります。 そのようなExcelファイルからDBに登録するためのインサート文を作成するために、いつもツールに悩むので作成して …

.NET Core: Azure AD B2Cユーザアカウント操作のサンプル

概要 管理者がAzure AD B2Cのユーザアカウントの管理が行えるASP.NET Coreのアプリの開発を想定している。Azure AD B2Cユーザアカウントの作成や更新等の操作はMicroso …

Javaにおけるファイルパスの正規化

サーバ側でのzipファイルの解凍等の際に、意図しないディレクトリやファイル(ディレクトリトラバーサル攻撃)へのアクセスを防ぐための検証として、絶対パスを正規化したい場合がある。 Fileクラスを使った …

DOSバッチリファレンス

ちょっとした事でbatファイルを作成することが多い。 そのたびにネット検索するのが非効率なため、リファレンス化しようと思う。 そういう目的なので、自分がよく調べる項目に絞っている。 開発時の注意点 直 …