Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Shapesコレクション・Shapeオブジェクト » 配列とTRANSPOSE関数を使って画像の位置とサイズをExcelに出力するパワポマクロ

配列とTRANSPOSE関数を使って画像の位置とサイズをExcelに出力するパワポマクロ

対象：PowerPoint2007, PowerPoint2010, PowerPoint2013

Functionプロシージャを利用して2次元配列に画像の位置やサイズを格納しておいて、一気にExcelに書き出す形のPowerPointマクロをご紹介しました。

今回はFunctionプロシージャを使わないで、ループ処理の中で配列のサイズ変更を繰り返しながらデータを格納して、Excelのワークシート関数TRANSPOSE関数を利用して、一気に書く出すマクロをご紹介します。

［スポンサードリンク］

配列とTRANSPOSE関数を使って画像の位置とサイズをExcelに出力するサンプルマクロ

以下のようなマクロで、画像の位置とサイズをExcelに出力することができます。

Sub 全画像の位置とサイズをExcelに出力_配列とTranspose関数の利用()

　Const P2CM = 1 / 72 * 2.54　'Points To CentiMeters

　Dim sld As Slide, shp As Shape
　Dim arr()　　　'スライド番号, 上端から, 左端から, 高さ, 幅
　Dim n As Long　'画像の数

　n = 0
　For Each sld In ActivePresentation.Slides
　　For Each shp In sld.Shapes
　　　If shp.Type = msoPicture Then
　　　　n = n + 1
　　　　ReDim Preserve arr(1 To 5, 1 To n)
　　　　arr(1, n) = sld.SlideIndex
　　　　arr(2, n) = shp.Top * P2CM
　　　　arr(3, n) = shp.Left * P2CM
　　　　arr(4, n) = shp.Height * P2CM
　　　　arr(5, n) = shp.Width * P2CM
　　　End If
　　Next shp
　Next sld
　If n = 0 Then
　　MsgBox "画像がないため処理を終了します。"
　　Exit Sub
　End If

　With CreateObject("Excel.Application")
　　.Workbooks.Add
　　.Range("A1").Value = ActivePresentation.Name
　　.Range("A2").Value = "スライド番号"
　　.Range("B2").Value = "上端から"
　　.Range("C2").Value = "左端から"
　　.Range("D2").Value = "高さ"
　　.Range("E2").Value = "幅"
　　.Range(.Cells(3, "A"), .Cells(n + 2, "E")).Value _
　　　　= .WorksheetFunction.Transpose(arr())　'行列を入れ替えデータ出力
　　.Range("A1:E2").Font.Bold = True
　　.Range("A1").CurrentRegion.EntireColumn.AutoFit
　　.Visible = True
　End With

End Sub

サンプルマクロの解説

アクティブなプレゼンテーションファイルの全Slideに対するFor Each～Nextループの中で、
　For Each sld In ActivePresentation.Slides
Slide内の全Shapeに対するFor Each～Nextループを回して、
　　For Each shp In sld.Shapes
Shapeの種別が画像だったときに、
　　　If shp.Type = msoPicture Then
　　　　n = n + 1
2次元配列のデータを残しつつサイズを変更しています。
　　　　ReDim Preserve arr(1 To 5, 1 To n)

ここで重要なのは、サイズを変更しているのが2次元配列の第2次元であるということです。

Excelに一気に書き出す処理を考えると、
　　　　ReDim Preserve arr(1 To n, 1 To 5)
を考えてしまいますが、VBA（Visual Basic for Applications）の多次元配列で要素数を変更できるのは、最後の次元だけですから、これではダメです。2次元配列の第1次元のサイズを変更しようとしているからです。

雰囲気としては、
　　　　ReDim Preserve arr(1 To 5, 1 To n)
というコードは、表の行数を5行で固定しておいて、列を増やすイメージです。

配列のサイズを拡大したら、スライド番号・上端からの距離・左端からの距離・高さ・幅を格納します。
　　　　arr(1, n) = sld.SlideIndex
　　　　arr(2, n) = shp.Top * P2CM
　　　　arr(3, n) = shp.Left * P2CM
　　　　arr(4, n) = shp.Height * P2CM
　　　　arr(5, n) = shp.Width * P2CM
この部分が、先日ご紹介したFunctionプロシージャを使ったマクロでは、
　　　　arr(n, 1) = sld.SlideIndex
　　　　arr(n, 2) = shp.Top * P2CM
　　　　arr(n, 3) = shp.Left * P2CM
　　　　arr(n, 4) = shp.Height * P2CM
　　　　arr(n, 5) = shp.Width * P2CM
となっていて大きく異なる部分です。

配列にデータを格納し終わったら、Excelを起動して、
　With CreateObject("Excel.Application")
ブックを追加して、
　　.Workbooks.Add
A1セルにプレゼンテーションファイル名を入力して、
　　.Range("A1").Value = ActivePresentation.Name
A2:E2セルに見出しを作成後、
　　.Range("A2").Value = "スライド番号"
　　.Range("B2").Value = "上端から"
　　.Range("C2").Value = "左端から"
　　.Range("D2").Value = "高さ"
　　.Range("E2").Value = "幅"
2次元配列のデータを一気に書き出しています。
　　.Range(.Cells(3, "A"), .Cells(n + 2, "E")).Value _
　　　　= .WorksheetFunction.Transpose(arr())

この部分もこのマクロの重要なポイントです。

配列の行・列を入れ替えるために、Excelのワークシート関数・TRANSPOSEを利用しています。

［関数の引数］ダイアログボックス：TRANSPOSE関数