PowerPoint の中にあるシェイプをレイアウトを保ったまま画像にする方法は、まずシェイプを選択します。
選択方法は、キー「Ctrl」を押しながら対象のシェイプをクリックして選択します。
次に、選択の対象物の中で右クリックしてメニューを表示します。
そのメニューの中にある「図として保存」をクリックします。
すると保存ダイヤログが表示されますので、それにしたがって保存します。
私は、シェイプの選択時のクリックが苦手で位置がずれることがしばしばあります。
それを解消するために作りました。
PowerPoint のスライド
スライド1
シェイプはスクエアが2個です。
名前を、「im_sq01」「im_sq02」とします。
スライド2
シェイプは丸が2個です。
名前を、「im_ci01」「im_ci02」とします。
マクロの実行
2022年11月2日に投稿した記事のフォームのレイアウトを使います。
ボタン「ダイヤログ」の名前・キャプションを変えて、下のコードを貼り付けています。
早速、ボタン「画像作成」をクリックして実行します。
サブフォルダー「picture」の中
想定とおりのファイルが作られています。
フォームのコード
Option Explicit
'-----------------------------------------
'ボタン「閉じる」のクリック
Private Sub bu閉じる_Click()
Unload Me
End Sub
'-----------------------------------------
'ボタン「画像作成」のクリック
Private Sub bu画像作成_Click()
Dim Shp As Shape
Dim Shps() As String
Dim ThisPath As String
Dim YMD As String
Dim FileName As Variant
Dim SlideNum As Long
Dim iCount As Long
'このプレゼンテーションのパス
ThisPath = ActivePresentation.Path
'保存する画像の名前、スライドが2つでなので
FileName = Array("TargetA", "TargetB")
'名前に日付を付加します。
YMD = "_" & Format(Date, "yyyy-mm-dd") & ".jpg"
'例では、スライドが2つでなので
For SlideNum = 1 To 2
iCount = 0
With ActivePresentation.Slides(SlideNum)
'とりあえずの数
ReDim Shps(.Shapes.Count - 1)
'条件にあうものを拾い上げます。
For Each Shp In .Shapes
'例は、シェイプの名前の頭2文字が im であること。
If Left(Shp.Name, 2) = "im" Then
Shps(iCount) = Shp.Name
iCount = iCount + 1
End If
Next Shp
'余分な配列は削除します。
ReDim Preserve Shps(iCount - 1)
With .Shapes.Range(Shps)
'サブディレクトリ pictue の中に保存します。
.Export PathName:=ThisPath & "\picture\" & _
FileName(SlideNum - 1) & YMD, _
Filter:=ppShapeFormatJPG
.Export PathName:=ThisPath & "\picture\" & _
FileName(SlideNum - 1) & ".jpg", _
Filter:=ppShapeFormatJPG
'指定できる画像の拡張子
'GIF ppShapeFormatGIF
'JPG ppShapeFormatJPG 例は JPG を指定しました。
'PNG ppShapeFormatPNG
'BMP ppShapeFormatBMP
'WMF ppShapeFormatWMF
'EMF ppShapeFormatEMF
End With
End With
'配列を初期化します。
Erase Shps
Next SlideNum
End Sub