如何批量把Word每段文字作为PPT每页的备注文字？

古豆 · 发表于 2020-11-11 12:26

Word 中有4个（不定，但和PPT中幻灯片页数相同）段落，也有空段，PPT中有4页（不定，但和Word段数相同），如何用VBA读取Word每一段文字插入到PPT的每一页备注上？（每页插入前先清除原备注文字）

以下为附件，谢谢大佬指点……

古豆 · 发表于 2020-11-11 17:22

求PowrPoint大佬帮助

shenjianrong163 · 发表于 2021-1-27 14:03

Sub test()
'每页插入WORD对应段落作为备注
With Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
.Filters.Clear
.Filters.Add "Word文件", "*.doc*"
.AllowMultiSelect = False
If .Show = -1 Then MyPath$ = .SelectedItems(1) Else Exit Sub
End With
Dim i%, j%, p%, wdApp, arr()
Set wdApp = CreateObject("Word.Application")
p = ActivePresentation.Slides.Count
With wdApp.Documents.Open(MyPath)
wdApp.Visible = False
For i = 1 To .Paragraphs.Count
ReDim Preserve arr(1 To i)
arr(i) = Replace(.Paragraphs(i).Range.Text, Chr(13), "")
Next
.Close False
End With
wdApp.Quit
Set wdApp = Nothing
If UBound(arr) < p Then MsgBox "Word中段落总数与PPT的张数不相等，请重新调整!": Exit Sub
For i = 1 To p
ActivePresentation.Slides.Item(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text = arr(i)
Next
MsgBox "处理完成!"
End Sub

复制代码

shenjianrong163 · 发表于 2021-1-27 14:05

附件供参考：

古豆 · 发表于 2021-1-29 21:52

shenjianrong163 发表于 2021-1-27 14:05
附件供参考：

太好用了！感谢 shenjianrong163 大佬！！！

没想这次遇到贵人啦～～～

		自动登录	找回密码
密码			免费注册

[求助] 如何批量把Word每段文字作为PPT每页的备注文字？