10行独立文本，如何分别插入到ppt页面中

zzpsx

文件夹内有10张图片，每张图片的文件名描述了这张图片。我把他们做成了ppt相册，希望把文字描述写到每页图片上面文本框内，左对齐。请问代码怎么写？

问题描述视频：
http://tbm.alicdn.com/laL1LyLR5N ... U9oZ0oB%40%40hd.mp4

zzpsx

我自己找到了一个办法，但是文字怎么放到上面去呢？ 如何批量把每页文字移入此处.rar (542.95 KB, 下载次数: 8)

2018-2-24 22:03 上传

点击文件名下载附件

leikaiyi123

建议你将你的插入图片的方法附上，人家给你修改就行了
不然就参考下面的代码吧：
Sub InsertPic()
    Dim i As Integer
    Dim MyDialog As FileDialog, vrtSelectdeItem As Variant
    On Error Resume Next
    '定义一个文件选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear  '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.jpg;*.bmp", 1   '增加筛选器的项目为所有jpg、bmp等文件
        .AllowMultiSelect = True                    '允许多项选择
        If .Show = -1 Then

            If ActivePresentation.Slides.Count < .SelectedItems.Count Then
                For i = 1 To .SelectedItems.Count - ActivePresentation.Slides.Count
                    ActivePresentation.Slides.Add(Index:=ActivePresentation.Slides.Count, Layout:=ppLayoutText).Select
                Next i
            End If

            i = 1
            For Each vrtselecteditem In .SelectedItems  '在所有选取项目中循环
                myname = CreateObject("Scripting.FileSystemObject").GetFileName(vrtselecteditem)   '取文件名
                ActivePresentation.Slides(i).Select
                With ActiveWindow.Selection.SlideRange
                    .FollowMasterBackground = msoFalse
                    .Background.Fill.UserPicture vrtselecteditem
                End With
                ActivePresentation.Slides(i).Shapes("Rectangle 2").TextFrame.TextRange = myname
                ActivePresentation.Slides(i).Shapes("Rectangle 2").TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
                i = i + 1
            Next vrtselecteditem
        
        End If
    End With

End Sub