Sub ceshi()
'在模板文件中按alt+f11，新建一模块，将代码粘贴进去，F5运行（工具-选项-宏安全性调为低）
'On Error Resume Next’测试无误后可将注释去掉
Dim sh As Shape, ta1 As Table, ta2 As Table
    ActivePresentation.Slides(5).Copy
    Open "F:\桌面\123.txt" For Input As #1
    arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) '读取txt文本到数组
    Close #1
    n = 1
    For i = 1 To UBound(arr) + 1
        ActiveWindow.View.Paste
    ac = ActivePresentation.Slides.Count
        ActivePresentation.Slides(ac).Select
        ActiveWindow.Selection.SlideRange(1).Shapes(1).TextFrame.TextRange = Split(arr(i), ",")(0) 'shapes(1)括号中到数字在出错时刻更改2,3，正确为止
        '*------------------------------------------------------------------*
        Set ta1 = ActiveWindow.Selection.SlideRange(2).Shapes(1).Table '填入第一个表格到两个数字
        ta1.Cell(2, 2).Shape.TextFrame.TextRange = Split(arr(i), ",")(1)
        ta1.Cell(2, 4).Shape.TextFrame.TextRange = Split(arr(i), ",")(2)
        '*------------------------------------------------------------------*
        Set ta2 = ActiveWindow.Selection.SlideRange(1).Shapes(3).Table '下面是插入图片
        For c = 1 To 2
            w = ta2.Cell(2, c).Shape.Width
            h = ta2.Cell(2, c).Shape.Height
            l = ta2.Cell(2, c).Shape.Left
            t = ta2.Cell(2, c).Shape.Top
            ActiveWindow.Selection.SlideRange.Shapes.AddPicture FileName:="修改成你的路径\" & n & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=l, Top:=t, Width:=w, Height:=h
            n = n + 1
            '*------------------------------------------------------------------*
        Next
    Next
    ActivePresentation.SaveAs "C:\123.ppt"
End Sub
复制代码