NDW

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

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






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

関連記事

Visual Studio 2019と開発用DB(LocalDB)

Visual Studio 2019でのASP.NET Coreを使ったシステム開発の標準化を検討している。 開発工程では技術検証、新機能向けのテーブル定義の検討、単体試験等を目的として、開発者が自由 …

.NET Core(C#): enumの使い方サンプル

はじめに サンプルは.NET Core 3.1 + C# 8.0で動作確認しています。 完全なソースコードはこちらで公開しています。 enumは基本的には数値型を保持しますが、文字列を保持したい場合は …

VULTRでRHEL8をインストール(1/2)

VULTRのVPSにRHEL8.3をインストールする手順を説明します。 概要 VULTRのVPSにRed Hat Enterprise Linux(RHEL)をインストールする手順を説明します。 実案 …

PowerPointの削除できない個人情報を消す

PowerPointで「個人情報の削除」を実行するとこで、作成者や会社名等の個人情報を削除できます。しかしながら、特定の項目に入った個人情報については、PowerPointやWindowsの標準機能で …

デジタル証明書のエンコードと拡張子の違い

デジタル証明書の種類と拡張子の理解が曖昧だったので整理してみました。 証明書や鍵そのものは基本的にはバイナリデータです。 これらのデータは、X.509やPKCSで仕様化されています。 X.509: 公 …