获取PPT每个幻灯片特定字符开头的某段内容到备注

jaco0420

求大神谢谢。已经自行摸索好几天，百度，chatgpt，都没能成功。


想把PPT每页的【解析】这一段内容剪切到备注，网上搜了已成功实现，每张ppt添加一样备注的功能。
剩下的每个PPT提取特定字符的某段，这个功能实在是没整出来。
求大神，谢谢。




Sub SlideNotesPageAdd0()

Dim SlideCount As Integer

SlideCount = ActivePresentation.Slides.Count

Dim i As Integer

For i = 1 To SlideCount

ActivePresentation.Slides.Item(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text = "备注AAAA"

Next i

End Sub

lss001

参考一下附件
例子.rar (72 KB, 下载次数: 7)

2023-9-30 22:31 上传

点击文件名下载附件

shenjianrong163

1. Sub addNotesPage()
   
2.     Dim sld As slide
   
3.     Dim shp As shape
   
4.     Dim i As Integer, j As Integer, k As Integer, n As Integer
   
5.     n = ActivePresentation.Slides.Count
   
6.     For i = 1 To n
   
7.         p = 0
   
8.         Set sld = ActivePresentation.Slides(i)
   
9.         For Each shp In sld.Shapes
   
10.             If shp.HasTextFrame Then
    
11.                 If shp.TextFrame.HasText Then
    
12.                     If shp.TextFrame.TextRange.text Like "*【解析】*" Then
    
13.                         With shp.TextFrame.TextRange
    
14.                             For j = 1 To .Paragraphs.Count
    
15.                                 If .Paragraphs(j).text Like "*【解析】*" Then
    
16.                                     sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text = .Paragraphs(j).text
    
17.                                     p = 1
    
18.                                     Exit For
    
19.                                 End If
    
20.                             Next
    
21.                             If p = 1 Then Exit For
    
22.                         End With
    
23.                     End If
    
24.                 End If
    
25.             End If
    
26.         Next shp
    
27.     Next i
    
28. End Sub

复制代码

jaco0420

lss001 发表于 2023-9-30 22:30
参考一下附件

谢谢大神，成提取了。还想加一个并删除该段特定字符的代码，应该怎么写？

jaco0420

shenjianrong163 发表于 2023-10-1 17:55

谢谢大神，批量成功。

shenjianrong163

jaco0420 发表于 2023-10-7 12:40
谢谢大神，成提取了。还想加一个并删除该段特定字符的代码，应该怎么写？

sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.text = .Paragraphs(j).text
在这句后面加上一句
.Paragraphs(j).delete