求助：把白居易的诗词单独提出来

常扬帆

想把把白居易的诗词单独提出来或者单独另存为一个文件，请高手不吝指教。万分感谢！

vbee

都是正文模式，要编程才行了

常扬帆

vbee 发表于 2022-9-12 15:09
都是正文模式，要编程才行了

衷心感谢您！

常扬帆

vbee 发表于 2022-9-12 15:09
都是正文模式，要编程才行了

如果删除其他，只留下白居易的诗呢？麻烦您了！

413191246se

* 楼主，请将代码复制到 VBE 中的 NewMacros 标准模块使用。
* 如果是 Word 2019，请将代码先复制到空白文档中，再全选、剪切、复制到 VBE 中，以防乱码。
* VBEE 老师的代码，略改。——按 Alt + F8 打开宏列表，找到并运行之。

1. Sub a0922_白居易()
   
2. '20220912 VBEE
   
3.     Dim p As Paragraph, b&, t$
   
4.     For Each p In ActiveDocument.Paragraphs
   
5.         If Left(p.Range.Text, 1) = "●" Then b = 0
   
6.         If Left(p.Range.Text, 4) = "●白居易" Then b = 1
   
7.         If b = 1 Then t = t & p.Range.Text & vbLf
   
8.     Next p
   
9.     ActiveDocument.Close False
   
10.     Documents.Add.Content.Text = t
    
11.     With ActiveDocument
    
12.         .Content.Find.Execute "(●)", , , 1, , , , , , "^p\1", 2
    
13.         .Paragraphs(1).Range.Text = "白居易" & vbCr
    
14.         .Paragraphs(1).Style = wdStyleHeading1
    
15.     End With
    
16. End Sub

复制代码

常扬帆

413191246se 发表于 2022-9-22 03:16
* 楼主，请将代码复制到 VBE 中的 NewMacros 标准模块使用。
* 如果是 Word 2019，请将代码先复制到空白文 ...

爽！衷心感谢您！

vbee

1. Sub bjy()
   
2. '20220922 VBEE
   
3. For Each p In ActiveDocument.Paragraphs
   
4. If Left(p.Range.Text, 1) = "●" Then b = 0
   
5. If Left(p.Range.Text, 4) = "●白居易" Then b = 1
   
6. If b = 0 Then p.Range.Delete
   
7. Next p
   
8. 
   
9. End Sub
   

复制代码

常扬帆

413191246se 发表于 2022-9-22 03:16
* 楼主，请将代码复制到 VBE 中的 NewMacros 标准模块使用。
* 如果是 Word 2019，请将代码先复制到空白文 ...

十分好用！衷心感谢您！