【Excel VBA】複数のパワーポイントファイルをPDFに一括変換
10数個ほどのパワーポイントファイルを、全てpdfに変換したいという状況がありました。あんまりよくあることではないんですけどね(;'∀')
1つ1つファイルを開いて手動で変換しても問題はなかったのですが、ちょっと手間だなと思ったので、VBAでやってみましたのでメモとして残しておきます。
手動でPDFに変換する方法
手動での変換はこちら↓ですね。便利なボタンがあります。ただ、こちらも知られていないことがありますので、一応紹介します。
「ファイル」を押して、エクスポートを選択すると、下記画面が出ますので、"PDF/XPS"を押せばPDF変換できます。このボタンをクイックアクセスツールバーに登録しておくと、さらに便利ですよ。
Office2010からだったでしょうか。Officeから直接PDF変換ができるようになりました。ありがたや。
Excel画面
Excel画面はこんな感じです。2つのボタンを置いてますが、ファイル名を取得して、そのファイルをPDF変換する感じですね。
コード:変数定義
定義はこちらです。ごちゃごちゃするので、分けて書いています。コード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で一括変換するコードを紹介しました。また機会を見てパワーポイントファイル以外の変換についても追記したいと思います。その際は、詳細な解説も追記できればと思います。
参考になれば幸いです。最後までお読みいただき、ありがとうございました。
この記事が参加している募集
この記事が気に入ったらサポートをしてみませんか?