PPT中添加多个图片

在ppt中插入多个图片并设置图片固定位置和大小

cpp 复制代码

Sub InsertImagesFixedPosition()
    Dim pptSlide As Slide
    Dim pptImage As Shape
    Dim imgPath As String
    Dim i As Integer
    Dim basePath As String
    Dim imgPaths() As String
    Dim imgCount As Integer
    
    ' 基础路径
    basePath = "C:\Users\xx\Desktop\picture\"
    
    ' 假设图片数量为 10，根据实际情况调整
    imgCount = 10
    
    ' 动态调整数组大小
    ReDim imgPaths(0 To imgCount - 1)
    
    ' 生成图片路径
    For i = 0 To imgCount - 1
        imgPaths(i) = basePath & (i + 1) & ".png"
    Next i
    
    ' 图片大小和位置（固定位置）
    Dim imgWidth As Single, imgHeight As Single
    Dim imgLeft As Single, imgTop As Single
    imgWidth = 200    ' 图片宽度
    imgHeight = 150   ' 图片高度
    imgLeft = 100     ' 图片左边距
    imgTop = 100      ' 图片顶边距
    
    ' 检查路径是否存在
    Dim invalidPaths As String
    invalidPaths = ""
    For i = LBound(imgPaths) To UBound(imgPaths)
        If Dir(imgPaths(i)) = "" Then
            invalidPaths = invalidPaths & imgPaths(i) & vbCrLf
        End If
    Next i
    
    If invalidPaths <> "" Then
        MsgBox "以下文件不存在，请检查：" & vbCrLf & invalidPaths, vbCritical
        Exit Sub
    End 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 Next
        Set pptImage = pptSlide.Shapes.AddPicture(FileName:=imgPath, _
                                                  LinkToFile:=msoFalse, _
                                                  SaveWithDocument:=msoTrue, _
                                                  Left:=imgLeft, _
                                                  Top:=imgTop, _
                                                  Width:=imgWidth, _
                                                  Height:=imgHeight)
        If Err.Number <> 0 Then
            MsgBox "插入图片失败：" & imgPath & vbCrLf & "错误：" & Err.Description, vbCritical
            Err.Clear
            Exit Sub
        End If
        On Error GoTo 0
    Next i
    
    MsgBox "图片已插入到每张幻灯片！", 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 点。