こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

パワーポイントのVBA

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

投稿日時 - 2019-10-01 22:41:59

QNo.9662684

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

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

質問では、どのような形で挿入したいか分からないので、Powerpointを画像保存(前回の回答)したフォルダーを指定して、Sheet1に縦一列に読み込んでみました。
画像の選別や画像ファイル名の変更、フォルダへのまとめはエクスプローラで行えば簡単で誰でもできるでしょう。短いマクロなので、2列、3列にしたり、いろいろ加工できるでしょう。
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

投稿日時 - 2019-10-02 17:51:42

ANo.1

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

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

投稿日時 - 2019-10-02 04:55:12

補足

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

投稿日時 - 2019-10-02 07:57:01

あなたにオススメの質問