PowerPoint (一般・VBA)

PowerPoint 一般・VBAに関する話題を扱うフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : PowerPoint 2016)
大量をPowerPoint資料、1枚目だけを画像(JPEG)で保存したいです
投稿日時: 19/12/18 22:16:58
投稿者: bunbun99

1つのフォルダ内に、大量のPowerPoint資料があります。
 
1枚目だけを画像(JPEG)で保存したいですが、
どのようにすれば良いかご教授頂けたらと思います。
 
 1.1つのフォルダに大量のPowerPointが保存。
 2.PowerPoint1枚目にはタイトル・名前が記載してあるので、
   それだけを画像(JPEG)保存する。
   ファイル名を、以下とする。
    01_12345.pptx → 01_12345jpeg

回答
投稿日時: 19/12/20 11:39:49
投稿者: sk

引用:
1.1つのフォルダに大量のPowerPointが保存。
2.PowerPoint1枚目にはタイトル・名前が記載してあるので、
  それだけを画像(JPEG)保存する。
  ファイル名を、以下とする。
   01_12345.pptx → 01_12345jpeg

(標準モジュール)
--------------------------------------------------------------
Sub SaveFirstSlideAsJpg()
     
    Dim prs As PowerPoint.Presentation
     
    Dim strFolderPath As String
    Dim strFileName As String
    Dim strPictureFolderPath As String
    Dim strPictureFilePath As String
     
    strFolderPath = "C:\FolderName\"
     
    If Dir(strFolderPath, vbDirectory) = "" Then
        MsgBox "'" & strFolderPath & "'というフォルダが見つかりません。", _
               vbExclamation, _
               "フォルダ参照エラー"
        Exit Sub
    End If
     
    strPictureFolderPath = strFolderPath & "jpg\"
     
    If Dir(strPictureFolderPath, vbDirectory) = "" Then
        MkDir strPictureFolderPath
    End If
     
    strFileName = Dir(strFolderPath & "*.ppt")
     
    If strFileName = "" Then
        MsgBox "'" & strFolderPath & "'フォルダに PowerPoint プレゼンテーションはありません。", _
               vbExclamation, _
               "ファイルなし"
        Exit Sub
    End If
    
    Do Until strFileName = ""
        Set prs = Presentations.Open(strFolderPath & strFileName, True, , False)
        strPictureFilePath = strPictureFolderPath & _
                             Left(strFileName, InStrRev(strFileName, ".")) & "jpg"
        prs.Slides(1).Export strPictureFilePath, "JPG"
        prs.Close
        Set prs = Nothing
        strFileName = Dir()
    Loop
     
    Shell "explorer.exe """ & strPictureFolderPath & """", vbMaximizedFocus
     
End Sub
--------------------------------------------------------------
 
以上のようなコードを実行なさればよろしいのではないかと。

投稿日時: 19/12/20 22:15:53
投稿者: bunbun99

sk様
 
ありがとうございます!!
単純、繰り返しの作業なので、悩んでました。。
 
大変感謝です!!