【PowerPointマクロ】スライド上の画像をJPEG画像に変えるマクロ

今回はスライド上の画像をJPEG画像に変えるマクロを紹介します。

プレゼンテーションファイルの中に重い画像が含まれているとファイルの容量が重くなってしまいますので、そんなときに使ってみて下さい。

プレゼンテーションファイル中の画像の容量を調べる方法は、過去記事をご覧ください。

【PowerPoint】プレゼンテーションファイル中の重い画像を探す方法

では以下コードです（PowerPoint2010で動作確認しています）

選択画像をJPEGファイル画像に変えるマクロ

Sub sample()

Dim T As Single, L As Single, H As Single, W As Single

With ActiveWindow.Selection.ShapeRange
  T = .Top
  L = .Left
  H = .Height
  W = .Width
  .Cut
End With

With ActiveWindow.Selection.SlideRange.Shapes.PasteSpecial(ppPasteJPG)
  .Top = T
  .Left = L
  .Height = H
  .Width = W
End With

End Sub

動作としては、"選択した画像を切り取り→JPEGファイルとして貼り付け→元画像があった位置に移動"です。

他の画像やオートシェイプとの重なりは考慮していないので、ご注意下さい。

次のコードはプレゼンテーションファイル中の全画像をJPEG画像に変えるマクロになります。

1つ1つ変えるのが面倒な場合に一括で変えることができます。

全スライドの全画像をJPEG画像に変えるマクロ

Sub sample2()

Dim T As Single, L As Single, H As Single, W As Single
Dim i As Long
Dim sld As Slide
Dim shp As Shape

For Each sld In ActivePresentation.Slides
  For i = sld.Shapes.Count To 1 Step -1
    If sld.Shapes(i).Type = msoPicture Then
      T = sld.Shapes(i).Top
      L = sld.Shapes(i).Left
      H = sld.Shapes(i).Height
      W = sld.Shapes(i).Width
      sld.Shapes(i).Cut
      
      With sld.Shapes.PasteSpecial(ppPastePNG)
        .Top = T
        .Left = L
        .Height = H
        .Width = W
      End With
    End If
  Next i
 
  For i = 1 To sld.Shapes.Count Step 1
    If sld.Shapes(i).Type = msoPicture Then
      sld.Shapes(i).ZOrder msoSendToBack
    End If
  Next i
Next sld

End Sub

1目のマクロと同様、画像を切り取り、JPEG画像として貼り付けています。

また、画像同士の重なりは再現されますが、オートシェイプ等との重なりは再現できません。

ファイルが重いなと思ったらやっみて下さい。

今回はこれで終わりです。ありがとうございました。