找回密码
 立即注册
搜索

PPT批量插入照片,有比这更好更快的方法吗?

6
回复
1004
查看
[复制链接]

3

主题

8

帖子

59

幻币

一流武者

Rank: 3Rank: 3

积分
254
QQ
2018-10-9 01:14:31 显示全部楼层 |阅读模式
190449xerealmlr6lr4pph.jpg


文件夹内有n张照片,想批量插入到ppt中,做成n张ppt页面,能否用vba或者批处理命令,我是03版。
PPT学习论坛
回复

使用道具 举报

1

主题

8

帖子

98

幻币

江湖少侠

Rank: 2

积分
181
QQ
2018-10-9 02:27:56 显示全部楼层
参考:http://club.excelhome.net/forum.php?mod=viewthread&tid=1395137&extra=page%3D1&mobile=2
13楼
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

10

帖子

7

幻币

一流武者

Rank: 3Rank: 3

积分
212
QQ
2018-10-9 02:30:57 显示全部楼层
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  '在所有选取项目中循环
                ActivePresentation.Slides(i).Select
                With ActiveWindow.Selection.SlideRange
                    .FollowMasterBackground = msoFalse
                    .Background.Fill.UserPicture vrtselecteditem
                End With
                i = i + 1
            Next vrtselecteditem
        
        End If
    End With

End Sub
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

6

帖子

22

幻币

一流武者

Rank: 3Rank: 3

积分
205
QQ
2018-10-9 03:46:44 显示全部楼层
134059oxrnr3trxy8zg6ii.jpg


谢谢高手,全选确定后,转到了代码页面。
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

6

帖子

7

幻币

一流武者

Rank: 3Rank: 3

积分
208
QQ
2018-10-9 03:46:56 显示全部楼层
谢谢,代码很好。我重新启动ppt 2003,这个代码就没有了,需要再输入模块,请问怎么办?谢谢
PPT学习论坛
回复 支持 反对

使用道具 举报

1

主题

6

帖子

50

幻币

江湖少侠

Rank: 2

积分
195
QQ
2018-10-9 03:50:15 显示全部楼层
做成ppa,工具栏上增加一按钮。
也可封装成ddl.
PPT学习论坛
回复 支持 反对

使用道具 举报

0

主题

9

帖子

47

幻币

江湖少侠

Rank: 2

积分
120
QQ
2018-10-9 05:48:28 显示全部楼层
做成ppa,工具栏上增加一按钮。
也可封装成dll.
PPT学习论坛
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册