ChatGPT×PowerPointで爆速で画像を作る方法

Sub CreateCustomSlideFromTemplate()
    Dim templateSlide As Slide
    Dim newSlide As Slide
    Dim shp As Shape
    Dim editedText As String
    Dim i As Integer
    
    ' テンプレートとして利用するスライドを選択
    On Error Resume Next
    Set templateSlide = Application.ActiveWindow.View.Slide
    On Error GoTo 0
    
    If templateSlide Is Nothing Then
        MsgBox "テンプレートとするスライドを選択してください。", vbExclamation
        Exit Sub
    End If
    
    ' 新規スライドを作成
    Set newSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, templateSlide.Layout)
    
    ' テンプレートのスライドからテキストボックスをコピーして新規スライドに追加し、その後テキストを編集
    For i = 1 To templateSlide.Shapes.Count
        If templateSlide.Shapes(i).Type = msoTextBox Then
            templateSlide.Shapes(i).Copy
            newSlide.Shapes.Paste
            Set shp = newSlide.Shapes(newSlide.Shapes.Count)
            editedText = InputBox("テキストを編集してください:", "テキスト編集", shp.TextFrame.TextRange.Text)
            shp.TextFrame.TextRange.Text = editedText
        End If
    Next i
    
    ' 新規スライドが選択されるようにする
    newSlide.Select
End Sub

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 = 85

    ' 一時的にスライドのサイズを調整する（サムネイル用）
    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.SaveAs filePath, ppSaveAsJPEG
    tempPresentation.Slides(1).Export fileName, "JPG", quality

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

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

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