[英]How to get a list that is immediately after heading 1 in Word VBA?
The following shows pattern of a very long document: 以下显示了一个很长文档的模式:
<heading1>
<numberedlist>
<heading2>
<numberedlist>
<heading3>
<numberedlist>
When I use Document.Lists
I get all the lists in the document. 当我使用Document.Lists
我得到了文档中的所有列表。 When Iterate using Document.Paragraphs
where Document.Paragraphs(i).Style = "Heading 1"
I get all the headings. 当使用Document.Paragraphs
Document.Paragraphs(i).Style = "Heading 1"
迭代Document.Paragraphs
,我得到了所有的标题。
But What I want is the List (not paragraph of the list) which is immediately after "Heading 1" 但我想要的是紧接在“标题1”之后的列表(不是列表中的段落)
Assuming that your document can look like one on the picture below: 假设您的文档看起来像下图中的文档:
Using this proposed code you would be able to select first list (immediate after heading) and other similar lists located below Heading but not the second (there is additional paragraph between heading and list- for that situation see additional comments inside code). 使用此提议的代码,您将能够选择第一个列表(标题后立即)和位于标题下方但不是第二个的其他类似列表(标题和列表之间还有其他段落 - 对于该情况,请参阅代码中的其他注释)。
Sub List_after_Heading()
Dim rngLIST As Range
Set rngLIST = ActiveDocument.Content
With rngLIST.Find
.Style = "Heading 1" '<--change into your Heading name
.Forward = True
.Wrap = wdFindStop
End With
Do
rngLIST.Find.Execute
If rngLIST.Find.Found Then
'I assume that list start in NEXT paragraph, if not, it wouldn't be found
'or you need to change part of line into .Next.Next paragraphs,
'alternatively some looping would be needed here
'we check if paragraph next to Heading contains a list
If rngLIST.Paragraphs(1).Next.Range.ListParagraphs.Count > 0 Then
'we have the list, but it's not easy to select at once
Dim iLIST As List
For Each iLIST In ActiveDocument.Lists
If iLIST.Range.Start = rngLIST.Paragraphs(1).Next.Range.Start Then
'here we have it... selected
iLIST.Range.Select
'or any other of your code here
End If
Next
End If
End If
Loop While rngLIST.Find.Found
End Sub
I use bookmarks to identify the Headings and then simply return the text between them. 我使用书签来识别标题,然后简单地在它们之间返回文本。 But I am not sure by what you mean by But What I want is the List (not paragraph of the list)
但我不确定你的意思But What I want is the List (not paragraph of the list)
ScreenShot 截图
Code 码
Option Explicit
Sub Sample()
Dim MyRange As Range
Selection.HomeKey Unit:=wdStory
On Error Resume Next
ActiveDocument.Bookmarks("MYStartBookMark").Delete
ActiveDocument.Bookmarks("MYEndBookMark").Delete
On Error GoTo 0
'~~> Find Heading 1
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Heading 1")
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute
End With
'~~> Move one space to the right
Selection.MoveRight Unit:=wdCharacter, Count:=1
'~~> Insert the start Book mark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="MYStartBookMark"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
'~~> Find Heading 2
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Heading 2")
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute
End With
'~~> Move one space to the left
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'~~> Insert the end Book mark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="MYEndBookMark"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
'~~> Identify the range between the Start BookMark and End BookMark
Set MyRange = ActiveDocument.Range
MyRange.Start = MyRange.Bookmarks("MYStartBookMark").Range.End
MyRange.End = MyRange.Bookmarks("MYEndBookMark").Range.Start
'~~> This gives you that text
Debug.Print MyRange.Text
'~~> Delete the BookMarks
On Error Resume Next
ActiveDocument.Bookmarks("MYStartBookMark").Delete
ActiveDocument.Bookmarks("MYEndBookMark").Delete
On Error GoTo 0
End Sub
Result 结果
OTHER TESTS 其他测试
One might say that what if we do not know what the next heading is? 有人可能会说,如果我们不知道下一个标题是什么呢? Which is a fair point as we can have two more scenarios. 这是一个公平的观点,因为我们可以有两个场景。 Let me cover them together 让我一起掩盖他们
MODIFIED CODE 修改后的代码
Option Explicit
Sub Sample()
Dim MyRange As Range
Dim MyArray
Dim strOriginal As String, strTemp As String
Dim numDiff As Long, i As Long, NextHd As Long
Dim NoNextHeading As Boolean
Selection.HomeKey Unit:=wdStory
On Error Resume Next
ActiveDocument.Bookmarks("MYStartBookMark").Delete
ActiveDocument.Bookmarks("MYEndBookMark").Delete
On Error GoTo 0
'~~> Get all the headings in the array
NoNextHeading = True
For i = LBound(MyArray) To UBound(MyArray)
strOriginal = RTrim$(MyArray(i))
strTemp = LTrim$(strOriginal)
numDiff = Len(strOriginal) - Len(strTemp)
numDiff = (numDiff / 2) + 1
'~~> If heading one is found and it is not the last heading
'~~> in the array then find what is the next heading
If numDiff = 1 And i <> UBound(MyArray) Then
strOriginal = RTrim$(MyArray(i + 1))
strTemp = LTrim$(strOriginal)
numDiff = Len(strOriginal) - Len(strTemp)
numDiff = (numDiff / 2) + 1
NextHd = numDiff
NoNextHeading = False
Exit For
End If
Next i
'~~> Find Heading 1
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Heading 1")
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute
End With
'~~> Move one space to the right
Selection.MoveRight Unit:=wdCharacter, Count:=1
'~~> Insert the start Book mark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="MYStartBookMark"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
If NoNextHeading = False Then
'~~> Find Heading NextHd
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Heading " & NextHd)
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute
End With
'~~> Move one space to the left
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Else
'~~> Move to the end of the document
ActiveDocument.Characters.Last.Select
Selection.Collapse
End If
'~~> Insert the end Book mark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="MYEndBookMark"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
'~~> Identify the range between the Start Book Mark and End BookMark
Set MyRange = ActiveDocument.Range
MyRange.Start = MyRange.Bookmarks("MYStartBookMark").Range.End
MyRange.End = MyRange.Bookmarks("MYEndBookMark").Range.Start
'~~> This give you that text
Debug.Print MyRange.Text
'~~> Delete the BookMarks
On Error Resume Next
ActiveDocument.Bookmarks("MYStartBookMark").Delete
ActiveDocument.Bookmarks("MYEndBookMark").Delete
On Error GoTo 0
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.