使用VBA选择文档中的代码段

Question

我想创建一个宏，它允许在文档中选择整个代码块。

这就是我目前所拥有的：

Sub SelectSnippet()
    Selection.Find.Style = ActiveDocument.Styles("Code")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
End Sub

问题是，它只选择下一行代码而不是整个代码段。

目视：

Answer 1

此代码应该可以胜任。请试试。

Sub SelectSnippet()

    Dim Styl As Variant
    Dim Rng As Range
    Dim Fnd As Boolean

    Styl = "Code"
    Set Rng = Selection.Range               ' start at the selection
    ' find the nearest different style before the selection
    With Rng
        Do While .Start > 1
            If .Style <> Styl Then Exit Do
            .Move wdCharacter, -1
        Loop
    End With

    ' look for the first occurrance of the style
    On Error Resume Next
    With Rng.Find
        .Text = ""
        .Style = Styl
        Fnd = .Execute
    End With
    If Err Then
        MsgBox Err.Description, vbInformation, "Can't find """ & Styl & """"
    End If

    If Fnd Then
        ' expand the range to the end of the style
        With Rng
            Do While .End < .Document.Characters.Count
                If .Document.Range(.End, .End + 1).Style <> Styl Then Exit Do
                .MoveEnd wdCharacter, 1
            Loop
            .Select                         ' select the range
        End With
    End If
End Sub

以下代码执行相同的工作，但仅查看完整段落。如果段落的一部分风格不同，则可能包含也可能不包含。

Sub NewSelectSnippet()

    Dim Styl As Variant
    Dim Rng As Range
    Dim DocRng As Range
    Dim p As Integer

    Styl = "Code"
    ' expand the section to include the entire paragraph
    Set Rng = Selection.Paragraphs(1).Range
    If Rng.Style <> Styl Then Exit Sub

    ' expand the range to include preceding paragraphs of same style
    Set DocRng = ActiveDocument.Range(0, Rng.End)
    With DocRng.Paragraphs
        For p = .Count To 1 Step -1
            If .Item(p).Range.Style = Styl Then
                Rng.MoveStart wdParagraph, -1
            Else
                Exit For
            End If
        Next p
    End With

    ' expand the range to include following paragraphs of same style
    With ActiveDocument.Paragraphs
        For p = (DocRng.Paragraphs.Count + 1) To .Count
            If .Item(p).Range.Style = Styl Then
                Rng.MoveEnd wdParagraph, 1
            Else
                Exit For
            End If
        Next p
    End With

    Rng.Select
End Sub