VBA批量插入图片到PPT，一页一图

Sub InsertPicturesIntoSlides()Dim pptApp As ObjectDim pptPres As ObjectDim pptSlide As ObjectDim strFolderPath As StringDim strFileName As StringDim i As Integer' 设置图片文件夹路径strFolderPath = "C:\您的图片文件夹路径\" ' 请替换为您的图片文件夹路径' 获取文件夹中的第一个文件strFileName = Dir(strFolderPath & "*.jpg") ' 假设图片为jpg格式，如有需要请更改文件类型' 检查是否有图片If strFileName = "" ThenMsgBox "没有找到图片文件。"Exit SubEnd If' 创建PowerPoint应用对象Set pptApp = CreateObject("PowerPoint.Application")pptApp.Visible = True' 添加新的演示文稿Set pptPres = pptApp.Presentations.Addi = 1 ' 初始化幻灯片编号' 循环插入每张图片到新的幻灯片Do While strFileName <> ""' 添加新的幻灯片Set pptSlide = pptPres.Slides.Add(i, ppLayoutBlank)' 在新的幻灯片中插入图片With pptSlide.Shapes.AddPicture(FileName:=strFolderPath & strFileName, _LinkToFile:=msoFalse, _SaveWithDocument:=msoCTrue, _Left:=0, _Top:=0, _Width:=pptSlide.Master.Width, _Height:=pptSlide.Master.Height).LockAspectRatio = msoTrueEnd With' 获取下一个文件strFileName = Dir()i = i + 1Loop' 清理Set pptSlide = NothingSet pptPres = NothingSet pptApp = Nothing
End Sub

注意“宏安全性”设置，改为启用和信任