Oscar Sun

                  Option Explicit

Sub 第集前後時間軸()'https://youtu.be/bOEaor57ajw 20190902
Const sTxt As String = "第39集"
Dim p As Paragraph, s1 As Long, end1 As Long
Dim rng第集 As Range, d As Document, ActiveD As Document
'set rng=ActiveDocument.Range.Find.Execute("^#",)
Set rng第集 = Selection.Range
Set ActiveD = ActiveDocument
Set d = Documents.Add()
For Each p In ActiveD.Paragraphs
    s1 = InStr(p.Range, sTxt)
    If s1 > 0 And p.Range.End > end1 Then
        If Not p.Range.Style Like "標題*" And InStr(p.Previous.Range.Text, "臉書直播") = 0 Then
            rng第集.SetRange p.Previous.Previous.Previous.Previous.Previous.Previous.Range.Start, p.Next.Next.Next.Next.Next.Next.Range.End
            d.Range.Text = d.Range.Text & Chr(13) & rng第集.Text
            end1 = p.Next.Next.Range.End
        End If
    End If
Next p
End Sub