PPT中添加多个图片

发布于:2024-12-23 ⋅ 阅读:(10) ⋅ 点赞:(0)

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

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. 将厘米转换为点:1 厘米 ≈ 28.35 点。
    • 宽度:5 × 28.35 ≈ 141.75 点。
    • 高度:3 × 28.35 ≈ 85.05 点。
    • 左边距:2 × 28.35 ≈ 56.7 点。
    • 顶边距:2 × 28.35 ≈ 56.7 点。