VBA批量导入多个文件夹下的图片到PPT
2021/5/16 10:26:44
本文主要是介绍VBA批量导入多个文件夹下的图片到PPT,对大家解决编程问题具有一定的参考价值,需要的程序猿们随着小编来一起学习吧!
1.需要导入到PPT的照片文件夹
- Coding
Sub InsertPicture() Dim oPPT As Presentation Dim oSlide As Slide Dim nSlide As Byte Dim oCL As CustomLayout Dim Shp As Shape Dim myFile Dim filearr() Dim filearr0() Dim myPath As String Dim sPath As String Dim FileName As String Dim files As String Dim x As String Set oPPT = PowerPoint.ActivePresentation 'sPath = "C:\Users\Desktop\VBA\Outbound Loading Audit 10.31\" With oPPT nSlide = .Slides.Count With oSlide For j = 2 To nSlide Set oSlide = ActivePresentation.Slides(j) oSlide.Select '选定当前ppt '以上为遍历每个PPT '------------------------------------------------------------------------------------------- myPath = Dir("C:\Users\jishen\Desktop\VBA\Outbound Loading Audit 10.31\", vbDirectory) 'vbDirectory只看文件夹 Do While myPath <> "" ReDim Preserve filearr0(k) filearr0(k) = Split(myPath & "") k = k + 1 myPath = Dir If myPath <> "." And myPath <> ".." And Trim(Mid(myPath, 1, 2)) = ActivePresentation.Slides(j).SlideNumber Then GoTo 100 End If Loop '以上为遍历每个文件夹,记得将文件夹名称前2位改成以数字开头,程序在此关联了ppt的页数 '---------------------------------------------------------------------------------------------- 100 sPath = "C:\Users\Desktop\VBA\Outbound Loading Audit 10.31\" & myPath myFile = Dir(sPath & "\*.jpg") Do While myFile <> "" ReDim Preserve filearr(i) filearr(i) = Split(myFile, ".")(0) i = i + 1 myFile = Dir Loop With oPPT For i = 0 To UBound(filearr) Step 6 On Error Resume Next 'Set oCL = .Slides(1).CustomLayout 'nSlide = .Slides.Count If i Mod 6 = 0 And i <> 0 Then 'Set oSlide = ActivePresentation Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i) & ".jpg", msoFalse, msoTrue, 301, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 1) & ".jpg", msoFalse, msoTrue, 518, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 2) & ".jpg", msoFalse, msoTrue, 735, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 3) & ".jpg", msoFalse, msoTrue, 301, 271, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 4) & ".jpg", msoFalse, msoTrue, 518, 271, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 5) & ".jpg", msoFalse, msoTrue, 735, 271, 216, 267) Else 'Set oSlide = .Slides(nSlide) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i) & ".jpg", msoFalse, msoTrue, 301, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 1) & ".jpg", msoFalse, msoTrue, 518, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 2) & ".jpg", msoFalse, msoTrue, 735, 1, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 3) & ".jpg", msoFalse, msoTrue, 301, 271, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 4) & ".jpg", msoFalse, msoTrue, 518, 271, 216, 267) Set Shp = oSlide.Shapes.AddPicture(sPath & "\" & filearr(i + 5) & ".jpg", msoFalse, msoTrue, 735, 271, 216, 267) End If Next i End With Next j End With End With MsgBox "完成" End Sub
3.完成后的样子
这篇关于VBA批量导入多个文件夹下的图片到PPT的文章就介绍到这儿,希望我们推荐的文章对大家有所帮助,也希望大家多多支持为之网!
- 2024-09-28AI给的和自己写的Python代码,都无法改变输入框的内容,替换也不行
- 2024-09-27Sentinel配置限流资料:新手入门教程
- 2024-09-27Sentinel配置限流资料详解
- 2024-09-27Sentinel限流资料:新手入门教程
- 2024-09-26Sentinel限流资料入门详解
- 2024-09-26Springboot框架资料:初学者入门教程
- 2024-09-26Springboot框架资料详解:新手入门教程
- 2024-09-26Springboot企业级开发资料:新手入门指南
- 2024-09-26SpringBoot企业级开发资料新手指南
- 2024-09-26Springboot微服务资料入门教程