Return to VBA Code Examples

PowerPoint VBA マクロの例とチュートリアル

Written by

Editorial Team

Reviewed by

Steve Rynearson

Translated by

masahiro yoshida

Last updated on 3月 16, 2022

In this Article

VBA（Visual Basic for Applications）マクロを使ったPowerPointの自動化に関する完全ガイドです。 以下では、多くの有用な例をご覧いただけます。

VBA PDF (無料ダウンロード)

Microsoft PowerPoint VBA チュートリアルを無料でダウンロードできます。または他のOfficeプログラムのVBAチュートリアル!

vba powerpoint tutorial pdf

ダウンロード

PowerPoint VBA（マクロ）チュートリアル

マクロを使用したプレゼンテーションとして保存する

VBAコードを含むプレゼンテーションは、PowerPointのマクロ有効プレゼンテーション（*.pptm）として 保存する必要があります。

vba powerpoint macro enabled jp

リボンの「開発者」タブを有効化する

VBAのコードを作成する前に、リボン上の「開発者」タブを有効にしておく必要があります。「ファイル」→「オプション」を選択し、「リボンのユーザー設定」をクリックして、右ペインの「開発者」のチェックボックスをオンにします。

powerpoint vba developer tab jp

PowerPointマクロの作成

PowerPoint VBAマクロの簡単な例です。

Sub SavePresentationAsPDF（）
    Dim pptName As String
    Dim PDFName As String
    
    ' PowerPointをPDFとして保存する
    pptName = ActivePresentation.FullName
    ' 名前の中のPowerPointファイルの拡張子をPDFに置き換える
    PDFName = Left(pptName, InStr(pptName, ".")) & "pdf"
    ActivePresentation.ExportAsFixedFormat PDFName, 2 ' ppFixedFormatTypePDF = 2 
End Sub

アクティブなプレゼンテーションをPDFとして保存します。コードの行はそれぞれ、以下の処理をしています。

  • PowerPoint名とPDF名用の変数を作成する
  • pptName変数にアクティブなプレゼンテーション名を代入する。
  • 完全なPDF名を作成する
  • プレゼンテーションをPDFとして保存する

PowerPointアプリケーション

PowerPointプレゼンテーション内でVBAコードを実行する場合、PowerPointアプリケーションはデフォルトのアプリケーションであり、明示的に参照しなくても操作することができます。新規プレゼンテーションの作成 プレゼンテーションを作成するには、PowerPointアプリケーションのAddメソッドを使用します。

Application.Presentations.Add
'または明示的な参照なし
Presentations.Add

新しいプレゼンテーションを開く

新規に白紙のプレゼンテーションを開くには、Application.Presentations コレクションのAddメソッドを使用します。

Presentation.Add

既存のプレゼンテーションを開く

既に作成したプレゼンテーションを開くには、Application.PresentationsコレクションのOpenメソッドを使用します。

Presentations.Open ("My Presentation.pptx")

上記のコードは、プレゼンテーションが、コードを含むPowerPointプレゼンテーションと同じディレクトリにあることを想定しています。

開いて変数に代入する

開いたプレゼンテーションを変数に代入して、要件に応じて操作できるようにする必要があります。

Dim ppt As Presentation
Set ppt = Presentations.Open("My Presentation.pptx")

アクティブなプレゼンテーションを参照する

VBAコード実行時にGUIでアクティブなプレゼンテーションを操作するには、参照先のActivePresentationを使用します。

'イミディエイトウィンドウにActivePresentationの名前を表示する
Debug.Print ActivePresentation.Name

現在のプレゼンテーションを保存する

以下のステートメントは、アクティブなプレゼンテーションを保存します。また一度も保存されていなかった場合は、「名前を付けて保存」ダイアログが表示されます。

ActivePresentation.Save

現在のプレゼンテーションを閉じる

最後に編集された後に保存されていない場合でも、以下のステートメントでアクティブなプレゼンテーションを閉じます。

ActivePresentation.Close

参考文献

既存のプレゼンテーション（名前）を変数に代入する

Dim myPresentationByName As Presentation
Set myPresentationByName = Application.Presentations("My Presentation")

アクティブなスライドを変数に代入する

Dim currentSlide As Slide
Set currentSlide = Application.ActiveWindow.View.Slide

インデックスによるスライドを変数に代入する

Dim mySlide As Slide
Set mySlide = ActivePresentation.Slides(11)

スライドの枚数を数える

Dim slideCount As Long
slideCount = ActivePresentation.Slides.Count

現在のスライドのインデックス番号を取得する

Dim currentSlideIndex As Integer
currentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndex

スライドショーの最後に空白のスライドを追加する

Dim slideCount As Long
Dim newSlide as Slide

slideCount = ActivePresentation.Slides.Count
Set newSlide = ActivePresentation.Slides.Add(slideCount + 1, 12)
' または ppLayoutBlank = 12 として
Set newSlide = ActivePresentation.Slides.Add(slideCount + 1, ppLayoutBlank)

現在のスライドの後にスライドを追加する

Dim newSlide As Slide
Dim currentSlideIndex as Integer

currentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndex
Set newSlide = ActivePresentation.Slides.Add(currentSlideIndex, ppLayoutBlank)

スライドを削除する

Dim currentSlideIndex as Integer

currentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndex
ActivePresentation.Slides(currentSlideIndex).Delete

特定のスライドに移動する

'4番のスライドに移動する
Application.ActiveWindow.View.GotoSlide (4)

スライドを移動する

スライドを古い位置から新しい位置に移動することができます。

'3枚目のスライドを1枚目に移動する
Dim oldPosition as integer, dim newPosition as integer

oldPosition = 3
newPosition = 1
ActivePresentation.Slides(oldPosition).MoveTo toPos:=newPosition

全スライドをループする

各スライドに対して何かをすることもできますし、すべてのスライドからいくつかのスライドを探し出し、コードを使って何かすることもできます。

Dim mySlide as Slide

For Each mySlide In ActivePresentation.Slides
   ' 変数 'mySlide' で参照される現在のスライドに何らかの処理を行う
   ' Debug.Print mySlide.Name
Next mySlide

アクティブスライドのすべての図形をループする

PowerPointプレゼンテーションは、図形を使うことで本来の力を発揮します。以下のコードでは、現在のスライドにあるすべての図形をループして、好きなように操作できるようにしています。

Dim currentSlide as Slide
Dim shp as Shape

Set currentSlide = Application.ActiveWindow.View.Slide
For Each shp In currentSlide.Shapes
  ' 変数 'shp' で参照されている現在の図形に何らかの処理を行う
  ' 例えば、イミディエイトウィンドウに図形の名前を表示
  Debug.Print shp.Name
Next shp

全スライドの全シェイプをループスルーする

すべてのスライドを通過するループを追加することで、プレゼンテーション内のすべての図形をループすることができます。

Dim currentSlide as Slide
Dim shp as Shape

For Each currentSlide In ActivePresentation.Slides
  For Each shp In currentSlide.Shapes
    ' 変数 'shp' で参照されている現在の図形に対して何らかの処理を行う
    Debug.Print shp.Name
  Next shp
Next currentSlide

アクティブスライドのすべてのテキストボックスをループする

テキストボックスは、PowerPointのプレゼンテーションで最も頻繁に使用される図形の一つです。図形タイプで判別してすべてのテキストボックスをループさせることができます。テキストボックスは、VBA定数msoTextBoxとして図形タイプが定義されています（定数の数値は17です）。

Dim currentSlide as Slide
Dim shp as Shape

Set currentSlide = Application.ActiveWindow.View.Slide
For Each shp In currentSlide.Shapes
  ' 図形タイプが msoTextBox であるかどうかを確認する 
  If shp.Type = 17 Then ' msoTextBox = 17
    'テキストボックスのテキストを印刷する
    Debug.Print shp.TextFrame2.TextRange.Text
  End If
Next shp

全スライドの全テキストボックスをループする

ここでも、すべてのスライドを通過するループを追加することで、プレゼンテーション内のすべてのテキストボックスをループすることができます。

Dim currentSlide as Slide Dim shp as Shape

For Each currentSlide In ActivePresentation.Slides
  For Each shp In currentSlide.Shapes
    ' 図形タイプがmsoTextBoxであるかどうかをチェックする 
    If shp.Type = 17 Then ' msoTextBox = 17
      ' 変数 'shp' で参照されるテキストボックスで何らかの処理を行う
      Debug.Print shp.TextFrame2.TextRange.Text
    End If
  Next shp
Next currentSlide

選択したスライドを新しいPPTプレゼンテーションにコピーする

新しいプレゼンテーションに特定のスライドをコピーするには、まず、既存のプレゼンテーションで必要なスライドを選択し、以下のコードを実行します。

Dim currentPresentation as Presentation
Dim currentSlide as Slide
Dim newPresentation as Presentation

' 現在のプレゼンテーションへの参照を保存する
Set currentPresentation = Application.ActivePresentation

' 現在のスライドへの参照を保存する
Set currentSlide = Application.ActiveWindow.View.Slide

' 新しいプレゼンテーションを追加して参照先に保存する
セットNewPresentation = Application.Presentations.Add

' 選択したスライドをコピーする
Selection.Copy

' 新しいプレゼンテーションに貼り付ける
NewPresentation.Slides.Paste

アクティブなスライドをアクティブなプレゼンテーションの末尾にコピーする

' 現在のスライドをコピーする
Application.ActiveWindow.View.Slide.Copy

' 最後に貼り付ける
ActivePresentation.Slides.Paste

PowerPointの便利なマクロの例

ここでは、タスクの実行方法を示す便利なマクロ例をいくつか紹介します。これらは、上記の概念を示すものでもあります。

スライドショー中にスライドを変更する

Sub ChangeSlideDuringSlideShow()
    Dim SlideIndex As Integer
    Dim SlideIndexPrevious As Integer
 
    ' スライドショー中に現在のスライドをスライド4に変更する
    SlideIndex = 4
    ' 現在のスライドショーウィンドウのインデックスはSlideShowWindowsコレクションの1番目
    SlideIndexPrevious = SlideShowWindows(1).View.CurrentShowPosition
    SlideShowWindows(1).View.GotoSlide SlideIndex
     
End Sub

全テキストボックスの全スライドのフォントを変更する

Sub ChangeFontOnAllSlides()
    Dim mySlide As slide
    Dim shp As Shape
    
    ' 全スライドのフォントサイズを変更する
    For Each mySlide In ActivePresentation.Slides
      For Each shp In mySlide.Shapes
        If shp.Type = 17 Then ' msoTextBox = 17
          ' フォントサイズを24に変更する
          shp.TextFrame.TextRange.Font.Size = 24
        End If
      Next shp
    Next mySlide
End Sub

すべてのテキストボックスの大文字と小文字を入れ替える

Sub ChangeCaseFromUppertoNormal()
    Dim mySlide As slide
    Dim shp As Shape
    
    ' すべてのスライドで大文字から小文字に変更する
    For Each mySlide In ActivePresentation.Slides
      For Each shp In mySlide.Shapes
        If shp.Type = 17 Then ' msoTextBox = 17
          ' 大文字を小文字に変更する
          shp.TextFrame2.TextRange.Font.Allcaps = False
        End If
      Next shp
    Next mySlide
End Sub

すべてのテキストボックスで大文字と小文字を入れ替える

Sub ToggleCaseBetweenUpperAndNormal()
    Dim mySlide As slide
    Dim shp As Shape
 
    ' すべてのスライドで大文字と小文字を入れ替える
    For Each mySlide In ActivePresentation.Slides
      For Each shp In mySlide.Shapes
        If shp.Type = 17 Then ' msoTextBox = 17
          ' 大文字と小文字を入れ替える
          shp.TextFrame2.TextRange.Font.Allcaps = _
            Not shp.TextFrame2.TextRange.Font.Allcaps
        End If
      Next shp
    Next mySlide 
End Sub

下線部の下線を除去する

タイポグラフィにおいて、ディセンダーとは、フォントのベースラインより下に伸びている文字の部分を指します。ほとんどのフォントでは、ディセンダーは g, j, q, p, y のような小文字のために確保されており、フォントによっては f にもあります。 テキストにアンダーラインを引くと、ディセンダーの下はきれいに見えなくなってしまいます。以下は、プレゼンテーション全体から、g, j, p, q, yのような文字からアンダーラインを取り除くコードです。

Sub RemoveUnderlineFromDescenders()
    Dim mySlide As slide
    Dim shp As Shape
    Dim descenders_list As String
    Dim phrase As String
    Dim x As Long
    
    ' ディセンダーからアンダーラインを削除する
    descenders_list = "gjpqy"
    For Each mySlide In ActivePresentation.Slides
      For Each shp In mySlide.Shapes
        If shp.Type = 17 Then ' msoTextBox = 17
         ' 文字 "gjpqy" からアンダーラインを削除する。
         With shp.TextFrame.TextRange
           phrase = .Text
           For x = 1 To Len(.Text)
             If InStr(descenders_list, Mid$(phrase, x, 1)) > 0 Then
              .Characters(x, 1).Font.Underline = False
             End If
           Next x
         End With
       End If
      Next shp
    Next mySlide 
End Sub

すべてのスライドからアニメーションを削除する

プレゼンテーションに設定されているすべてのアニメーションを削除するには、次のコードを使用します。

Sub RemoveAnimationsFromAllSlides()
    Dim mySlide As slide
    Dim i As Long 
    For Each mySlide In ActivePresentation.Slides
      For i = mySlide.TimeLine.MainSequence.Count To 1 Step -1
       ' アニメーションを削除する
       MySlide.TimeLine.MainSequence.Item(i).Delete
      Next i
    Next MySlide
End Sub

プレゼンテーションをPDFで保存する

簡単にPDF形式でアクティブプレゼンテーションを保存することもできます。

Sub SavePresentationAsPDF（）。
    Dim pptName As String
    Dim PDFName As String
    
    ' PowerPointをPDFとして保存する
    pptName = ActivePresentation.FullName
    ' 名前の中のPowerPointファイルの拡張子をpdfに置き換える
    PDFName = Left(pptName, InStr(pptName, ".")) & "pdf" （Left(pptName, InStr(pptName, ".")) & "pdf"
    ActivePresentation.ExportAsFixedFormat PDFName, 2 ' ppFixedFormatTypePDF = 2
 
End Sub

テキストの検索と置換

すべてのスライドのすべてのテキストボックスで、テキストを検索および置換することができます。検索したいテキストの最初のインスタンス (findWhat で定義) の後、他のインスタンスがある場合は Find コマンドをループして検索する必要があります。

Sub FindAndReplaceText()
    Dim mySlide As slide
    Dim shp As Shape
    Dim findWhat As String
    Dim replaceWith As String
    Dim ShpTxt As TextRange
    Dim TmpTxt As TextRange

    findWhat = "jackal"
    replaceWith = "fox"
     
    ' 検索と検索と置換
    For Each mySlide In ActivePresentation.Slides
      For Each shp In mySlide.Shapes
        If shp.Type = 17 Then ' msoTextBox = 17
          Set ShpTxt = shp.TextFrame.TextRange
          ' 最初のインスタンスを検索する（存在する場合）
          Set TmpTxt = ShpTxt.Replace(findWhat, _
             Replacewhat:=replaceWith, _
             WholeWords:=True)
     
          ' 次のインスタンスを検索する（存在する場合）
          Do While Not TmpTxt Is Nothing
            Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length,ShpTxt.Length)
            Set TmpTxt = ShpTxt.Replace(findWhat, _
              Replacewhat:=replaceWith, _
              WholeWords:=True)
          Loop
        End If
      Next shp
    Next mySlide
End Sub

スライドを画像として書き出す

現在の、または他のスライドをPNG、JPG（JPEG）、BMP画像としてエクスポートすることができます。

Sub ExportSlideAsImage()
    Dim imageType As String
    Dim pptName As String
    Dim imageName As String
    Dim mySlide As slide
    
    ' 現在のスライドを画像にエクスポートする
    imageType = "png" ' または jpg または bmp
    pptName = ActivePresentation.FullName
    imageName = Left(pptName, InStr(pptName, ".")) & imageType
    Set mySlide = Application.ActiveWindow.View.slide
    mySlide.Export imageName, imageType
End Sub

スライド全体を覆うように画像をリサイズする

Sub ResizeImageToCoverFullSlide()
    Dim mySlide As slide
    Dim shp As Shape

    ' 画像をスライドサイズにリサイズする
    ' 現在のスライド上の最初のシェイプの高さと幅を変更する
    ' スライドの寸法に合わせる
    Set mySlide = Application.ActiveWindow.View.slide
    Set shp = mySlide.Shapes(1)
    ''
    ''現在選択されている図形を拡大し、
    ''何も選択されていない場合はエラーになるようにしたい場合、 
    ''上記の2つのステートメントを以下のステートメントに入れ替える
    'Set shp = ActiveWindow.Selection.ShapeRange(1)
     
    With Shp
        .LockAspectRatio = False
        .Height = ActivePresentation.PageSetup.SlideHeight
        .Width = ActivePresentation.PageSetup.SlideWidth
        .Left = 0
        .Top = 0
    End With
 
End Sub

実行中のスライドショーをすべて終了させる

複数のスライドショーを同時に開いている場合は、以下のマクロを使用してすべてのスライドショーを閉じることができます。

Sub ExitAllRunningSlideShows()
    Do While SlideShowWindows.Count > 0
        SlideShowWindows(1).View.Exit
    Loop
End Sub

ExcelからPowerPointを自動化する

また、他のアプリケーション（ExcelやWordなど）からPowerPointに接続することもできます。最初のステップとして、PowerPointのインスタンスを参照する必要があります。

これには2つの方法があり、それぞれ事前バインディング 、 遅延バインディング と呼ばれています。

PowerPointを開く – 事前バインディング

事前バインディングでは、VBE（Visual Basic Editor）で「Microsoft PowerPoint 16 Object Library」（MS Office 2019用）への参照を「ツール」→「参照設定」で明示的に設定しておく必要があります。

' 事前バインディング
Dim pptApp As Application
Set pptApp = New PowerPoint.Application

PowerPointを開く – 遅延バインディング

遅延バインディングでは、アプリケーション変数がオブジェクトとして宣言され、VBAエンジンは実行時に正しいアプリケーションに接続します。

' 遅延バインディング
Dim pptApp As Object
Set pptApp = CreateObject("PowerPoint.Application")

アプリケーションを表示させる

PowperPointアプリケーションへの参照を設定した後、それを可視化する必要がある場合があります。

pptApp.Visible = True

PowerPointを操作する

上記で作成したPowerPointへの参照を追加するだけで、PowerPoint内部からプレゼンテーションを操作するためのすべてのメソッドをExcelから使用することができます。 例えば

Presentations.Open ("My Presentation.pptx")

は、このように使用する必要があります。

pptApp .Presentations.Open ("My Presentation.pptx")

アプリケーションを閉じる

PowerPointアプリケーションでやりたいことが完了したら、アプリケーションを終了し、参照を解除する必要があります。

pptApp.Quit
Set pptApp = Nothing

ExcelからPowerPointへコピーする

このコードでは、ExcelからPowerPointに範囲をコピーします。

備考 : VBAを使用してExcelからPowerPointに範囲をコピーする方法を示すために、できるだけシンプルにしてあります。

Sub copyRangeToPresentation()

' 新しいPowerPointのインスタンスを開く
Set pptApp = CreateObject("PowerPoint.Application")

With pptApp
    ' 新しいプレゼンテーションを作成する
    Set ppt = .Presentations.Add
    ' 空白のスライドを追加する
    Set newSlide = ppt.Slides.Add(1, 12) ' ppLayoutBlank = 12
    ' Excelのアクティブシートから範囲をコピーする
    ActiveSheet.Range("A1:E10").Copy
    ' パワーポイントに画像として貼り付ける
    newSlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
    ' パワーポイントに切り替える
    .Activate
End With

End Sub

PowerPoint VBAのよくある質問

PPTのマクロとは何ですか？

マクロは、タスクを自動化するためのプログラミング命令のセットを指す一般的な用語です。PowerPoint（PPT）のマクロは、プログラミング言語VBAを使用してPowerPointのタスクを自動化します。

PowerPointでVBAを使用するにはどうすればよいですか？

PowerPointでVBAを使用するには、VBA Editorを開きます（ALT + F11またはDeveloper > Visual Basic）。

PowerPointでマクロを作成する方法を教えてください。

  1. VBAエディタ（ALT + F11またはDeveloper > Visual Basic）を起動します
  2. 「挿入」→「モジュール」でコードモジュールを作成します
  3. 「Sub HelloWorld」と入力し、Enterキーを押します
  4. 「Sub HelloWorld」と「End Sub」の間の行に「MsgBox “Hello World!”」と入力します
  5. これでマクロの完成です！
  6. F5キーを押してマクロを実行します

執筆者 : Vinamra Chandra

vba-free-addin

VBA Code Examples Add-in

Easily access all of the code examples found on our site.

Simply navigate to the menu, click, and the code will be inserted directly into your module. .xlam add-in.

(No installation required!)

Free Download

Return to VBA Code Examples

automacro

AutoMacro: VBA Add-in with Hundreds of Ready-To-Use VBA Code Examples & much more!

Learn More