今回はFileDialogを使って選択したJPEGファイルを貼るマクロについて書きます。
マクロの動作としてはスライドを追加して、そこに画像を張り付けます。複数の画像を選択した場合は、1スライドに付き1枚画像を貼ります。
PowerPointに元々ある機能の"挿入"タブ→"図"と似てますが、図形のサイズ指定ができるので、同じような画像を連続して貼る場合は便利かも。
初期フォルダにマイドキュメントを表示されているのですが、下記サイトさんを参考にさせて頂きました。
Office TANAKA - Excel VBA Tips[特殊フォルダを取得する]
では、コードです（PowerPoint2010で動作確認してます）。
VBAコード
Sub sample()
Dim i As Long, SldIndex As Long
Dim MasterH As Single, MasterW As Single
Dim Path As String, WSH As Variant
'表示される初期フォルダをマイドキュメントにする準備
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("MyDocuments") & "\"
'スライドの幅、高さを取得
With ActivePresentation.SlideMaster
MasterH = .Height
MasterW = .Width
End With
'選択されているスライドのインデックスを取得
SldIndex = ActiveWindow.Selection.SlideRange.SlideIndex
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = Path '初期表示フォルダの設定
.Filters.Add "JPEG Image", "*.jpg; *.jpeg" '表示されるファイル形式を指定
If (.Show = True) Then '開くボタンが押されたら以下を実行
For i = 1 To .SelectedItems.Count
'スライドを追加
With ActivePresentation.Slides.Add(SldIndex + i, ppLayoutBlank)
.Select
End With
'選択したファイルを張り付ける
With ActiveWindow.Selection.SlideRange.Shapes.AddPicture(.SelectedItems(i), msoFalse, msoTrue, 10, 10)
'.Width =
'.Height =
.Left = (MasterW - .Width) / 2 '横位置の中心に設定
.Top = (MasterH - .Height) / 2 '縦位置の中心に設定
End With
Next i
End If
.Filters.Clear
End With
Set WSH = Nothing
End Sub
コードの説明
FileDialogを使ってファイル選択ダイアログを表示させて、選択した画像を追加したスライドに貼ります。
複数画像の場合は、スライドの追加→貼り付けを繰り返します。
Pathにマイドキュメントのパスを入れ、.InitialFileNameに設定することで、初期表示フォルダをマイドキュメントにしています。
最初の方にスライドの幅と高さを取得し、張り付けた画像の大きさから真ん中の位置を算出します。
一見回りくどいように見えますが、画像を選択せずに中心位置に持ってこれるので、慣れれば便利だと思います。
.Filters.Add "JPEG Image", "*.jpg; *.jpeg" はダイアログの中で表示させるファイル形式を設定しており、*.tif;みたいに足すことができます。
複数の画像を張り付けれるようにFor文を作り、その中でスライド追加→画像貼り付け
を繰り返します。
上記コードではコメントアウトしていますが、.Width =や.Height =で貼り付けた画像の大きさを設定することもできます。
今回はこんな感じです。
まじめに作ってみたのですが、標準の機能に毛が生えた程度のものになってしまいました。
このままでは使いにくいので、目的に応じてカスタマイズを。。。
FileDialogは名前を付けて保存ダイアログからファイルの保存もできるので、興味があればこちらも覗いてみて下さい。
