在ppt中插入多个图片并设置图片固定位置和大小
Sub InsertImagesFixedPosition()Dim pptSlide As SlideDim pptImage As ShapeDim imgPath As StringDim i As IntegerDim basePath As StringDim imgPaths() As StringDim imgCount As Integer' 基础路径basePath = "C:\Users\xx\Desktop\picture\"' 假设图片数量为 10,根据实际情况调整imgCount = 10' 动态调整数组大小ReDim imgPaths(0 To imgCount - 1)' 生成图片路径For i = 0 To imgCount - 1imgPaths(i) = basePath & (i + 1) & ".png"Next i' 图片大小和位置(固定位置)Dim imgWidth As Single, imgHeight As SingleDim imgLeft As Single, imgTop As SingleimgWidth = 200 ' 图片宽度imgHeight = 150 ' 图片高度imgLeft = 100 ' 图片左边距imgTop = 100 ' 图片顶边距' 检查路径是否存在Dim invalidPaths As StringinvalidPaths = ""For i = LBound(imgPaths) To UBound(imgPaths)If Dir(imgPaths(i)) = "" TheninvalidPaths = invalidPaths & imgPaths(i) & vbCrLfEnd IfNext iIf invalidPaths <> "" ThenMsgBox "以下文件不存在,请检查:" & vbCrLf & invalidPaths, vbCriticalExit SubEnd If' 循环插入图片For i = LBound(imgPaths) To UBound(imgPaths)imgPath = imgPaths(i)Debug.Print imgPath ' 输出路径到即时窗口' 添加新的幻灯片Set pptSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)' 插入图片On Error Resume NextSet pptImage = pptSlide.Shapes.AddPicture(FileName:=imgPath, _LinkToFile:=msoFalse, _SaveWithDocument:=msoTrue, _Left:=imgLeft, _Top:=imgTop, _Width:=imgWidth, _Height:=imgHeight)If Err.Number <> 0 ThenMsgBox "插入图片失败:" & imgPath & vbCrLf & "错误:" & Err.Description, vbCriticalErr.ClearExit SubEnd IfOn Error GoTo 0Next iMsgBox "图片已插入到每张幻灯片!", vbInformation
End Sub
在 PowerPoint VBA 中,设置图片大小和位置的单位是 点(Point,Pt)。1 点等于 1/72 英寸,也就是 0.352777 毫米。
具体含义
-
宽度(Width) 和 高度(Height): 控制图片的宽度和高度,单位为点。例如:
Width = 200
表示图片宽度约为 200 点,即 2.78 英寸(200 ÷ 72)。Height = 150
表示图片高度约为 150 点,即 2.08 英寸(150 ÷ 72)。
-
左边距(Left) 和 顶边距(Top): 控制图片在幻灯片上的位置,单位为点。例如:
Left = 100
表示图片左边缘距离幻灯片左边框约为 1.39 英寸(100 ÷ 72)。Top = 100
表示图片上边缘距离幻灯片顶部约为 1.39 英寸(100 ÷ 72)。
转换示例
假设需要设置:
- 图片宽度为 5 厘米。
- 图片高度为 3 厘米。
- 左上角距离幻灯片左边和顶部的距离为 2 厘米。
计算方法:
- 将厘米转换为点:1 厘米 ≈ 28.35 点。
- 宽度:
5 × 28.35 ≈ 141.75
点。 - 高度:
3 × 28.35 ≈ 85.05
点。 - 左边距:
2 × 28.35 ≈ 56.7
点。 - 顶边距:
2 × 28.35 ≈ 56.7
点。
- 宽度: