View Single Post
 
Old 04-04-2022, 09:38 AM
Italophile Italophile is offline Windows 11 Office 2021
Expert
 
Join Date: Mar 2022
Posts: 554
Italophile is just really niceItalophile is just really niceItalophile is just really niceItalophile is just really nice
Default

Code:
Sub autt()
    Dim bln As Boolean, doc As Document, i As Integer, ii As Integer
    Set doc = ActiveDocument

    For i = 1 To ActiveDocument.Range.Paragraphs.Count
        Set Para = doc.Paragraphs(i)
        If Selection.Information(wdWithInTable) = False Then
            Para.Range.Select

            bln = strr()
            
            If bln = True Then
                If Not Left(Para.Range.Style, 1) = "1" Then
                    If Para.Range.Words(1) = Chr(9) Or Para.Range.Words(2) = Chr(9) And bln = True Then
                        Para.Range.Style = "tt"
                    ElseIf Para.LeftIndent = 0 And Para.FirstLineIndent = 0 Then
                        Para.Range.Style = "t"
                    End If
                    If Para.Range.Words(3) = Chr(9) Then
                        Para.Range.Style = "tt"
                    End If
                End If
            End If
           
        Else
            ii = Selection.Tables(1).Range.Paragraphs.Count
            i = iparanum + ii
        End If
    Next

End Sub

Function strr() As Boolean
    Dim x As Integer, rngg As String, y As Integer
    strr = False
    rngg = Selection.Range.Text
    x = Len(rngg): y = InStr(1, rngg, ":")
    If x - y < 3 And x - y >= 1 Then
        If Selection.Range.Text Like "*." & vbTab & "*" Then
            With Selection
                If .Paragraphs(1).Next.Range.Characters(1).Text = Chr(9) Then
                    .Paragraphs(1).Next.Range.Characters(1).Delete
                    .Range.Style = "tt"
                    .Range.Bold = True
                End If
                .Range.Characters(x).Delete
                .Range.Style = "tt"
                .Range.Bold = True
                strr = True
            End With
        End If
    End If
End Function
Reply With Quote