Excel VBAを使用してファイルオープンダイアログから指定したフォルダ内のPowerPointファイルを任意に選択し、すべてのテキストを黒に変更し、PDFに変換する

Sub ConvertSelectedPowerPointToPDF()
Dim ppApp As Object
Dim ppPres As Object
Dim ppSlide As Object
Dim shp As Object
Dim txtRng As Object
Dim fileExtension As String
Dim fileName As String
Dim filePath As String
Dim pdfPath As String
Dim objFSO As Object
Dim objFile As Object
Dim fileDialog As Object
Dim selectedFiles As Object

'フォルダの選択ダイアログを表示
Set fileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fileDialog
.Title = "フォルダを選択してください"
.InitialFileName = "C:\Users\example\Documents\PowerPoint\"
.AllowMultiSelect = True
If .Show <> -1 Then Exit Sub
filePath = .SelectedItems(1)
End With

'PowerPointアプリケーションを開く
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True

'選択されたPowerPointファイルを処理する
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set selectedFiles = fileDialog.SelectedItems
For Each objFile In selectedFiles
'PowerPointファイルを開く
fileExtension = objFSO.GetExtensionName(objFile)
If LCase(fileExtension) = "pptx" Or LCase(fileExtension) = "ppt" Then
Set ppPres = ppApp.Presentations.Open(objFile)
'すべてのスライドに対してテキストの色を変更する
For Each ppSlide In ppPres.Slides
For Each shp In ppSlide.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
txtRng.Font.Color.RGB = RGB(0, 0, 0)
End If
Next shp
Next ppSlide
'PDFに変換する
fileName = objFSO.GetBaseName(objFile)
pdfPath = objFSO.GetParentFolderName(objFile) & "\PDF\"
ppPres.ExportAsFixedFormat pdfPath & fileName & ".pdf", 2
'PowerPointファイルを閉じる
ppPres.Close
End If
Next objFile

'PowerPointアプリケーションを終了する
ppApp.Quit

'メッセージを表示
MsgBox "PDFに変換が完了しました。"

End Sub