【ChatGPT×PowerPoint】スライドをJPEG出力するマクロを作った話 - コトゼニ～学習塾とボクと、時々プログラミング〜

【PR】この記事には広告を含む場合があります。

記事内で紹介する商品を購入することで、当サイトに売り上げの一部が還元されることがあります。

(記事内のリンクの一部はアフィリエイトリンクです。詳しくはプライバシーポリシー&免責事項をご覧ください)

当ブログでは、記事作成のためにパワーポイントで画像を作成し、見出しの下に段落のまとめを挟むよう心掛けています。

しかし、簡単な画像とはいえ、手間がかかることも事実。

そこで、マクロを活用して作業効率化を試みました。ChatGPTにマクロ製作を依頼し、作ったマクロの挙動がこちらです。

このようにマクロを実行すると指定したスライドをJPEG形式で出力してくれます。

わずかな時間とはいえ、量が多くなれば大量の時間の節約になることも事実。

そこでこの記事ではchatGPTとのやりとりとプロンプトの例を記事で紹介しています。

ぜひ最後まで読んでみてください！

1 マクロ作成の経緯・前提
2 ChatGPTとのやりとり・プロンプト
3 まとめ

マクロ作成の経緯・前提

当ブログでは

SEO対策の一つとしてオリジナルな画像を利用した方が良いと聞いたことがある
読者もそこまでじっくり段落を読まない

ということを踏まえ、

記事の見出しのすぐ下に挟む画像もなるべく、その段落のまとめを画像にするようにしています。

コトゼニ

こんな感じです

ただ、このような画像を作るのは地味に手間なんです。

コトゼニ

新しいスライドにコピーして、テキストボックスの文言を変えて、JPEGで出力して…

その作業を効率化するために、

テンプレートに指定したスライドのコピーを作成しテキストボックスの文言を変えられるマクロ
完成したスライドをJPEG画像として出力できるようにするマクロ

この2つのマクロをPowerPointに搭載しました。

▶︎テンプレートに指定したスライドのコピーを作成しテキストボックスの文言を変えられるマクロ製作の話はこちらの記事で紹介しています。

2023年7月24日【ChatGPT×PowerPoint】テンプレスライドをコピーしテキストボックスの内容を変えられるマクロを作った話

このマクロの要件・実現したいこと

指定したスライドをJPEG画像として出力できる
出力されるのはJPEGファイルだけで良い
出力されるサイズが100KB以下が望ましい
JPEG画像として保存する際にファイル名を指定（入力）できる

これらを満たすマクロを作れるように、ChatGPTと相談しました！

ChatGPTとのやりとり・プロンプト

実際にChatGPTにどのようなプロンプトを投げていたのかを紹介します。

現在のスライドをJPEG形式で出力できるようにする

まずはJPEG画像として出力できるようにすることが必要です。投げかけたプロンプトはこちらです。

コトゼニ

以下の要件満たすvbaで作成してください。

・いま編集しているスライドのみをjpgで出力する。

・保存先は選べるようにする。

・なるべく出力するファイルのサイズは100KB以下にする。

chatGPT

以下のVBAコードは、現在編集中のスライドのみをJPEG形式で出力し、保存先を選択できるようにし、出力するファイルのサイズを100KB以下に制限します。

Option Explicit

Sub ExportSlideAsJPEG()
    Dim sld As Slide
    Dim shp As Shape
    Dim filePath As Variant
    Dim quality As Long
    Dim tempWidth As Long
    Dim tempHeight As Long

    ' 現在のスライドを取得
    Set sld = ActiveWindow.View.Slide

    ' ファイルの保存先を選択
    filePath = Application.GetSaveAsFilename(InitialFileName:=sld.Name, _
                                             FileFilter:="JPEG Files (*.jpg), *.jpg")

    ' ファイル保存がキャンセルされた場合は処理を終了
    If filePath = False Then
        Exit Sub
    End If

    ' JPEG画像の品質を設定（0から100の範囲、0が最低品質）
    quality = 85

    ' 一時的にスライドのサイズを調整する（サムネイル用）
    tempWidth = sld.Parent.PageSetup.SlideWidth
    tempHeight = sld.Parent.PageSetup.SlideHeight
    sld.Parent.PageSetup.SlideWidth = 300
    sld.Parent.PageSetup.SlideHeight = 225

    ' スライドのコンテンツをコピー
    sld.Copy

    ' 新しい一時的なプレゼンテーションを作成
    Dim tempPresentation As Presentation
    Set tempPresentation = Presentations.Add

    ' 貼り付け
    tempPresentation.Slides.Paste

    ' スライドの画像をJPEGで保存
    tempPresentation.SaveAs filePath, ppSaveAsJPEG, EmbedTrueTypeFonts:=False, _
                            JPEGQuality:=quality

    ' 一時的なプレゼンテーションを閉じる
    tempPresentation.Close

    ' スライドのサイズを元に戻す
    sld.Parent.PageSetup.SlideWidth = tempWidth
    sld.Parent.PageSetup.SlideHeight = tempHeight

    ' 出力したファイルサイズをチェックして、100KBを超えていた場合は再度保存
    Dim fso As Object
    Dim fileSize As Double
    Set fso = CreateObject("Scripting.FileSystemObject")
    fileSize = fso.GetFile(filePath).Size / 1024 ' KB単位でファイルサイズを取得

    Do While fileSize > 100
        ' 品質を5%ずつ下げて再保存
        quality = quality - 5

        ' 新しい一時的なプレゼンテーションを作成
        Set tempPresentation = Presentations.Add

        ' 貼り付け
        tempPresentation.Slides.Paste

        ' スライドの画像をJPEGで保存
        tempPresentation.SaveAs filePath, ppSaveAsJPEG, EmbedTrueTypeFonts:=False, _
                                JPEGQuality:=quality

        ' 一時的なプレゼンテーションを閉じる
        tempPresentation.Close

        ' 出力したファイルサイズを再度チェック
        fileSize = fso.GetFile(filePath).Size / 1024 ' KB単位でファイルサイズを取得
    Loop

    ' メッセージボックスで出力完了を通知
    MsgBox "スライドがJPEGファイルとして保存されました。", vbInformation
End Sub

これを実行してみると、

コンパイルエラー：メソッドが見つからないと表示されてしまいました。

コトゼニ

3行目前後のGetSaveAsFilenameの部分でコンパイルエラーが発生しました。修正案を示してくれますか？

chatGPT

申し訳ありません、13行目で発生しているコンパイルエラーは、コード内の ppSaveAsJPEG が未定義とされているためです。このエラーを修正するためには、VBAの定数 ppSaveAsJPEG を適切な値で定義する必要があります。

VBAでは、PowerPointのファイル形式に関連する定数は通常 pp で始まりますが、ppSaveAsJPEG は正確な定数名ではなく、代わりに ppSaveAsJPG を使用する必要があります。

再度示されたコードを実行しても、狙い通りにはならず。

そこから様々試行錯誤を踏んで、とりあえず出力できるようになりました。

しかし

JPEG画像として保存する際にファイル名を指定（入力）できない
出力した画像サイズが小さすぎる
同時にフォルダが作成され出力されてしまう

という問題が残ったため、これらを解消するために引き続き、修正を依頼しました。

JPEG画像として保存する際にファイル名を指定（入力）できる

いまのままでは出力されたファイルがデフォルトの名前になるので、出力後に「名前の変更」を行なわないといけません。そのため、出力時にファイル名を指定できるようにします。

コトゼニ

「（ChatGPTが提示したコードのコピペ）」というコードをエクスポートして保存する前に「ファイル名を入力するポップアップのようなフォームを表示させ、入力された値をファイル名にする（拡張子はjpg）」ように編集してください。

chatGPT

了解しました。ファイル名を入力するポップアップのフォームを表示し、入力された値をファイル名にするように修正します。

以下が修正されたコードです：

’ これより以前のコードと同じです...
（省略）

  ' ファイル名を入力するポップアップを表示
    Dim fileName As String
    fileName = InputBox("ファイル名を入力してください。", "ファイル名入力", sld.Name)

    ' 入力がキャンセルされた場合は処理を終了
    If fileName = "" Then
        Exit Sub
    End If

    ' 拡張子が.jpgでない場合は追加
    If LCase(Right(fileName, 4)) <> ".jpg" Then
        fileName = fileName & ".jpg"
    End If

　　' 以下、以前のコードと同じです...
    ' (省略)

これで出力される前にファイル名を入力できるようになりました。

出力した画像サイズが小さすぎる

出力した画像のサイズが意外と小さく、テキストボックスの文字もぼやけてしまうほど。そこを修正するように指示。

コトゼニ

「’ 一時的にスライドのサイズを調整する（サムネイル用） tempWidth = sld.Parent.PageSetup.SlideWidth tempHeight = sld.Parent.PageSetup.SlideHeight sld.Parent.PageSetup.SlideWidth = 300 sld.Parent.PageSetup.SlideHeight = 225」の部分を修正して、現在のスライドサイズと同じサイズにしてください

chatGPT

了解しました。以下のように修正し、現在のスライドのサイズと同じサイズになるようにします：

’ これより以前のコードと同じです...
（省略）

    ' 一時的にスライドのサイズを調整する（サムネイル用）
    tempWidth = sld.Parent.PageSetup.SlideWidth
    tempHeight = sld.Parent.PageSetup.SlideHeight

　　' 以下、以前のコードと同じです...
    ' (省略)

ひとまずこれで現在のスライドと同じサイズで出力されるようになりました。

最終的には出力サイズを


    ' JPEG画像の品質を設定（0から100の範囲、0が最低品質）
    quality = 85

の部分で調整することにしました（調整後のコードは最後に掲載）

同時にフォルダが作成され出力されてしまう（JPEGファイルだけにしたい）

これまでのコードでは不要なフォルダも出力されてしまいました。

こんな感じです。

フォルダの中のJPEGファイルに入力したファイル名が反映されておらず、フォルダ名に反映されてしまっています。

そこで

コトゼニ

このコードの場合、出力先にフォルダが作成され、その中に、jpegファイルが格納された状態で出力されてしまいます。出力時にフォルダは不要なので出力されないように修正してください

chatGPT

了解しました。フォルダを作成せずに直接指定したファイルパスにJPEGファイルを出力するように修正します。


’ これより以前のコードと同じです...
（省略）

 ' 保存先のパスを作成
    filePath = ActivePresentation.Path & "\" & fileName

　　' 以下、以前のコードと同じです...
    ' (省略)

しかし、修正されたコードを実行しても結果は変わらず。

そこで少しググってみて、Exportメソッドが使えそうと考えたため、以下のように修正を依頼しました。

コトゼニ

変わらずフォルダが作成されてしまいます。「tempPresentation.SaveAs filePath, ppSaveAsJPEG 」の部分をExportメソッドで代替することはできますか？

chatGPT

フォルダが作成される原因は、tempPresentation.SaveAsの代わりにExportメソッドを使っていないことです。

フォルダを作成せずに直接ファイルに出力するには、Exportメソッドを使用します。以下が修正されたコードです：


’ これより以前のコードと同じです...
（省略）

    ' スライドの画像をJPEGで保存
    tempPresentation.Slides(1).Export fileName, "JPG", quality

　　' 以下、以前のコードと同じです...
    ' (省略)

これによってJPEG画像だけが出力されるようになりました。

完成したマクロのコード

以上のようなやりとりを経て、出来上がったマクロがこちらです。

Sub ExportSlideAsJPEG()
    Dim sld As Slide
    Dim shp As Shape
    Dim filePath As Variant
    Dim quality As Long
    Dim tempWidth As Long
    Dim tempHeight As Long
    Const ppSaveAsJPEG As Long = 17 ' JPEGのファイル形式を表す定数

    ' 現在のスライドを取得
    Set sld = ActiveWindow.View.Slide

    ' ファイル名を入力するポップアップを表示
    Dim fileName As String
    fileName = InputBox("ファイル名を入力してください。", "ファイル名入力", sld.Name)

    ' 入力がキャンセルされた場合は処理を終了
    If fileName = "" Then
        Exit Sub
    End If

    ' 拡張子が.jpgでない場合は追加
    If LCase(Right(fileName, 4)) <> ".jpg" Then
        fileName = fileName & ".jpg"
    End If

    ' 保存先のパスを作成
    filePath = ActivePresentation.Path & "\" & fileName

    ' JPEG画像の品質を設定（0から100の範囲、0が最低品質）
    quality = 1000

    ' 一時的にスライドのサイズを調整する（サムネイル用）
    tempWidth = sld.Parent.PageSetup.SlideWidth
    tempHeight = sld.Parent.PageSetup.SlideHeight

    ' スライドのコンテンツをコピー
    sld.Copy

    ' 新しい一時的なプレゼンテーションを作成
    Dim tempPresentation As Presentation
    Set tempPresentation = Presentations.Add

    ' 貼り付け
    tempPresentation.Slides.Paste

    ' スライドの画像をJPEGで保存

    tempPresentation.Slides(1).Export fileName, "JPG", quality

    ' 一時的なプレゼンテーションを閉じる
    tempPresentation.Close

 
    ' メッセージボックスで出力完了を通知
    MsgBox "スライドがJPEGファイルとして保存されました。", vbInformation

    ' スライドのサイズを元に戻す
    sld.Parent.PageSetup.SlideWidth = tempWidth
    sld.Parent.PageSetup.SlideHeight = tempHeight
End Sub