请教如何用VBA代码实现直接删除折叠标题和其内容

batmanbbs

RT，见下图
PS：除了使用搜索标题确定区域后删除的办法之外，还有直接利用VBA属性（比如大纲的相关属性）做到这点吗？

batmanbbs

请知道的朋友不吝赐教 或者 提供一下其他的解题思路，谢谢！

sylun

可试试如下代码（仅适用于MS word）:

1. Sub test1()
   
2.     '在大纲视图下删除标题3及其所属下级段落内容，仅MS Word中
   
3.     Dim i%
   
4.     Application.ScreenUpdating = False
   
5.     With ActiveDocument.ActiveWindow.View
   
6.         i = .Type
   
7.         If i <> 2 Then .Type = wdOutlineView
   
8.         .ShowHeading 3
   
9.         With Selection
   
10.             .EndKey wdStory
    
11.             Do
    
12.                 '可用标题样式或大纲级别作判断
    
13.                 If .Style = "标题 3" Then ActiveDocument.Content.Bookmarks("\HeadingLevel").Range.Delete
    
14.             Loop Until .MoveUp(wdParagraph) = 0
    
15.         End With
    
16.         If i <> 2 Then .Type = i
    
17.     End With
    
18.     Application.ScreenUpdating = True
    
19. End Sub
    

复制代码

如用在WPS，可试试

1. Sub test2()
   
2.     '在大纲视图下删除标题3及其所属下级段落内容，仅WPS
   
3.     Dim i%, j%, n%, rngstart&, rngend&
   
4.     Application.ScreenUpdating = False
   
5.     With ActiveDocument.ActiveWindow.View
   
6.         i = .Type
   
7.         If i <> 2 Then .Type = wdOutlineView
   
8.         .ShowHeading 3
   
9.         With Selection
   
10.             .EndKey wdStory
    
11.             rngend = ActiveDocument.Content.End
    
12.             Do
    
13.                 .StartOf wdParagraph
    
14.                 If .ParagraphFormat.OutlineLevel = wdOutlineLevel3 Then
    
15.                     ActiveDocument.Range(.Start, IIf(rngend > 0, rngend, rngstart)).Delete
    
16.                     j = j + 1
    
17.                     rngend = 0
    
18.                     rngstart = .Start
    
19.                 ElseIf .ParagraphFormat.OutlineLevel < 3 Then
    
20.                     rngend = .Start
    
21.                 End If
    
22.                 n = .MoveUp(wdParagraph)
    
23.             Loop Until n = 0
    
24.         End With
    
25.         If i <> 2 Then .Type = i
    
26.     End With
    
27.     MsgBox "共删除了" & j & "个区域。"
    
28.     Application.ScreenUpdating = True
    
29. End Sub
    

复制代码

考虑到只是大纲，只用moveup方法循环，均未作详细测试，也许有更快捷的方法。

batmanbbs

谢谢，就是这一类的解题思路，明天我认真学习并测试一下。

batmanbbs

有些明白了，跟踪了一下代码发现，核心是对HeadingLevel书签的处理，大纲模式只是提高了查找的速度。非常谢谢！

PS：经过测试，老师提供的第一组代码在WPS下也有效果。

梧叶沙沙

batmanbbs 发表于 2023-6-8 17:41
有些明白了，跟踪了一下代码发现，核心是对HeadingLevel书签的处理，大纲模式只是提高了查找的速度。非常谢 ...

本身就可以一次性选中某一级别的标题。删除就好了。不用插件。

batmanbbs

梧叶沙沙 发表于 2023-6-9 13:04
本身就可以一次性选中某一级别的标题。删除就好了。不用插件。

老师，能提供一下一次性选中某一级别标题和某一级大纲后删除的代码吗？我很想学习一下，谢谢。