パワーポイントのVBA

質問

20Pほどあるパワーポイントを1Pごとにスライドを分割して、それぞれ別のファイルとして特定のフォルダに保存するマクロを作成したいのですが、何かいい方法はありますでしょうか

回答No.2

nishi6

＞シートごとにリネーム、エクセルにシートのタイトルごとに分けて記入、
＞さらに特定のフォルダにまとめる
この質問の中で一番避けたいのが、多数の画像をExcelに取り込む作業です。
カットアンドペーストでは、Bookの肥大化が気になります。画像の挿入もイライラします。

質問では、どのような形で挿入したいか分からないので、Powerpointを画像保存（前回の回答）したフォルダーを指定して、Sheet1に縦一列に読み込んでみました。
画像の選別や画像ファイル名の変更、フォルダへのまとめはエクスプローラで行えば簡単で誰でもできるでしょう。短いマクロなので、２列、３列にしたり、いろいろ加工できるでしょう。
Excelの標準モジュールに貼り付けます。

Sub 画像の挿入()
　'// 画像があるフォルダーを指定
　Dim imgFolder As String　'// 画像があるフォルダー
　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show = True Then
　　　imgFolder = .SelectedItems(1)
　　Else
　　　Exit Sub
　　End If
　End With

　'// 画像を表示するセルの大きさ
　'// Powerpointの画像なので、縦横比を決め打ち
　'// imgWidthを大きくしたらimgRowsを調整する
　'// 　　　　　　　　　　　(自動計算していない)
　Dim ws1 As Worksheet
　Const imgWidth = 32.5　 '// 画像の幅
　Const imgHeight = 13.5　'// 画像の高さ
　Const imgRows = 11　　　'// 画像表示用の行数

　Set ws1 = Worksheets("Sheet1")
　　ws1.Activate　'// 画像を貼り付けるシートの設定
　　Columns("B:B").ColumnWidth = imgWidth
　　Cells.RowHeight = imgHeight

　Dim rwNum As Long　　 '// 行ステップ 13行ごと
　rwNum = 3　　　　　　 '// 表示開始行

　'// 画像を貼り付ける
　Dim myIMG As String　　　 '// 画像
　Const expand = "*.jpg"　　'// 拡張子

　myIMG = Dir(imgFolder & "\" & expand)
　While myIMG <> ""
　　Cells(rwNum, 1) = myIMG
　　ActiveSheet.Pictures.Insert(imgFolder & "\" & myIMG).Select
　　　With Selection
　　　　.Top = Cells(rwNum + 1, 2).Top + 2
　　　　.Left = Cells(rwNum + 1, 2).Left
　　　　.Width = imgWidth
　　　　.Height = imgHeight * imgRows
　　　End With
　　rwNum = rwNum + imgRows + 2

　　myIMG = Dir()
　Wend
End Sub

回答No.1

nishi6

当方Powerpoint2010ですが、質問の機能は、マクロを作るまでもなく、名前を付けて保存で、ファイルの種類をPNG、JPEG、GIF、BMPなどにすれば、1，2秒で済みます。

Powerpointのマクロの習得が目的なら、最近のPowerpointはマクロの記録ができなくなっているので、基本的な手順の書き方や、メソッド、プロパティの内容を知ることが必要でしょう。

補足

毎日20~30ほどシートがある資料を分割し、シートごとにリネーム、エクセルにシートのタイトルごとに分けて記入、さらに特定のフォルダにまとめるという仕事があるのですがいかんせん量が多いのでどうにかならないかと模索していたところです
少し試してダメなようならnisi6さんの方法でやろうと思います、ありがとうございました