見出し画像

【Excel VBA】複数のパワーポイントファイルをPDFに一括変換

10数個ほどのパワーポイントファイルを、全てpdfに変換したいという状況がありました。あんまりよくあることではないんですけどね(;'∀')

1つ1つファイルを開いて手動で変換しても問題はなかったのですが、ちょっと手間だなと思ったので、VBAでやってみましたのでメモとして残しておきます。

手動でPDFに変換する方法

手動での変換はこちら↓ですね。便利なボタンがあります。ただ、こちらも知られていないことがありますので、一応紹介します。

「ファイル」を押して、エクスポートを選択すると、下記画面が出ますので、"PDF/XPS"を押せばPDF変換できます。このボタンをクイックアクセスツールバーに登録しておくと、さらに便利ですよ。

Office2010からだったでしょうか。Officeから直接PDF変換ができるようになりました。ありがたや。

PDF変換

Excel画面

Excel画面はこんな感じです。2つのボタンを置いてますが、ファイル名を取得して、そのファイルをPDF変換する感じですね。

画像1

コード:変数定義

定義はこちらです。ごちゃごちゃするので、分けて書いています。コード1,2で共通なので、コード1のSubより上に書いてます。

Dim buf As String, cnt As Long
Dim ws As Worksheet
Dim i As Integer, LastRow As Integer
Dim Path As String, PPT As Object
Dim dir_path As String, file_name As String, ppt_path As String, pdf_file As String, target_file As String
Dim dot As Long

コード1:ファイル名を取得

まず、ファイル名を取得します。

Sub get_filename()
   Set ws = Worksheets("Sheet1")
   ws.Range("A3:A1000").ClearContents
   Path = ThisWorkbook.Path & "\"
   buf = Dir(Path & "*")
   Do While buf <> ""
   cnt = cnt + 1
   Cells(cnt + 2, 3) = buf 'C列にファイル名を取得
   buf = Dir()
   Loop
   cnt = 0
End Sub

コード2:一気にPDFに変換

次にパワーポイントを一括でPDF変換します

Sub ppt_pdf_save_ALL()
   Set ws = Worksheets("Sheet1")
   dir_path = ThisWorkbook.Path
   LastRow = ws.Cells(Rows.Count, 3).End(xlUp).Row 'C列の最終行
   Set PPT = CreateObject("PowerPoint.Application")
   For i = 3 To LastRow
       target_file = ws.Cells(i, "C") 'C列にファイル名
       ppt_path = dir_path & "\" & target_file
       dot = InStrRev(target_file, ".")
       file_name = Left(target_file, dot - 1) '拡張子より前のファイル名を取得
       pdf_file = dir_path & "\" & file_name & ".pdf"
       With PPT.Presentations.Open(ppt_path)
         .SaveAs Filename:=pdf_file, FileFormat:=32
         .Close
       End With
   Next
   PPT.Quit
   Set PPT = Nothing
End Sub

以下の部分について。拡張子より前のファイル名を取得して、file_nameに代入しています。

dot = InStrRev(target_file, ".")
file_name = Left(target_file, dot - 1) '拡張子より前のファイル名を取得

まとめ

パワーポイントファイルをVBAで一括変換するコードを紹介しました。また機会を見てパワーポイントファイル以外の変換についても追記したいと思います。その際は、詳細な解説も追記できればと思います。

参考になれば幸いです。最後までお読みいただき、ありがとうございました。

この記事が参加している募集

noteでよかったこと

この記事が気に入ったらサポートをしてみませんか?