none
Analyze paragraph indent values and add comment RRS feed

  • Question

  • I want to know is there a way to add comments to paragraphs in a selection from lowest to highest left indent values.

    For Example

    Para 1 – Left Indent 0.25”

    Para 2 – Left Indent 0.25”

    Para 3 – Left Indent 0.5”

    Para 4 – Left Indent 0.5”

    Para 5 – Left Indent 0.75”

    Para 6 – Left Indent 0.75”

    So when select this paragraph range it should add comments for

    Para 1 and 2 - Indent level 1

    Para 3 and 4 - Indent level 2

    Para 5 and 6 - Indent level 3

    Here's what i have so far:

    Sub ListIndents()
    
    Dim apar As Paragraph
    Dim coll As New Collection
    Dim itmx As Variant
    Dim List As String
    
    On Error Resume Next
        
    For Each apar In Selection.Paragraphs
    coll.Add Item:=apar.LeftIndent, Key:=CStr(apar.LeftIndent)
    Next par
        
    On Error GoTo 0
        
    For Each itmx In coll
        List = List & vbCrLf & Application.PointsToInches(itmx)
    Next itmx
    
        For Each apar In Selection.Paragraphs
    
            If apar.Range.ParagraphFormat.LeftIndent = coll.Item(1) Then
               apar.Range.Font.Color = wdColorBlue
               apar.Range.Comments.Add Range:=apar.Range, Text:="102"
            End If
    
            If apar.Range.ParagraphFormat.LeftIndent = coll.Item(2) Then
               apar.Range.Font.Color = wdColorBrown
               apar.Range.Comments.Add Range:=apar.Range, Text:="104"
            End If
    
            If apar.Range.ParagraphFormat.LeftIndent = coll.Item(3) Then
               apar.Range.Font.Color = wdColorDarkYellow
               apar.Range.Comments.Add Range:=apar.Range, Text:="106"
            End If
    
            If apar.Range.ParagraphFormat.LeftIndent = coll.Item(4) Then
               apar.Range.Font.Color = wdColorPlum
               apar.Range.Comments.Add Range:=apar.Range, Text:="108"
            End If
    
        Next
    
    End Sub

    I manged to write out this macro with the help of MVP Hans's macro of adding data to a collection but this is not exactly working unto that adding comment part. Also I would like to know is there a way to sort the collection in ascending order. Another problem I'm having is when this runs in a table selection only the first comment adds. I cant really find out whats causing that. 

    I value every opinion. Thank you in advance..

    Regards

    ___________________

    Supun Samarakoon


    • Edited by Supunsam Sunday, August 28, 2016 8:31 PM
    Sunday, August 28, 2016 8:29 PM

Answers

  • Try this. It should work as long as there are no more than 8 different left indent values in the selection.

    Sub ListIndents()
        Dim apar As Paragraph
        Dim coll As New Collection
        Dim itmx As Variant
        Dim List As String
        Dim i As Long
        Dim arrColors(1 To 8) As Long

        arrColors(1) = vbBlack
        arrColors(2) = vbBlue
        arrColors(3) = vbGreen
        arrColors(4) = vbRed
        arrColors(5) = vbYellow
        arrColors(6) = vbCyan
        arrColors(7) = vbMagenta
        arrColors(8) = RGB(128, 128, 128)

        On Error Resume Next
        For Each apar In Selection.Paragraphs
            coll.Add Item:=apar.LeftIndent, key:=CStr(apar.LeftIndent)
        Next apar
        On Error GoTo 0

        SortCollection coll

        For Each itmx In coll
            List = List & vbCrLf & Application.PointsToInches(itmx)
        Next itmx

        For Each apar In Selection.Paragraphs
            For i = 1 To coll.Count
                If apar.Range.ParagraphFormat.LeftIndent = coll(i) Then
                    apar.Range.Font.Color = arrColors(i)
                    apar.Range.Comments.Add Range:=apar.Range, Text:=CStr(100 + 2 * i)
                End If
            Next i
        Next apar
    End Sub

    Sub SortCollection(coll As Collection)
        Dim i As Long
        Dim j As Long
        Dim itm As Variant
        For i = 1 To coll.Count - 1
            For j = i + 1 To coll.Count
                If coll(i) > coll(j) Then
                    itm = coll(j)
                    coll.Remove j
                    coll.Add Item:=itm, key:=CStr(itm), Before:=i
                End If
            Next j
        Next i
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Supunsam Monday, August 29, 2016 12:14 PM
    Sunday, August 28, 2016 9:27 PM

All replies

  • Try this. It should work as long as there are no more than 8 different left indent values in the selection.

    Sub ListIndents()
        Dim apar As Paragraph
        Dim coll As New Collection
        Dim itmx As Variant
        Dim List As String
        Dim i As Long
        Dim arrColors(1 To 8) As Long

        arrColors(1) = vbBlack
        arrColors(2) = vbBlue
        arrColors(3) = vbGreen
        arrColors(4) = vbRed
        arrColors(5) = vbYellow
        arrColors(6) = vbCyan
        arrColors(7) = vbMagenta
        arrColors(8) = RGB(128, 128, 128)

        On Error Resume Next
        For Each apar In Selection.Paragraphs
            coll.Add Item:=apar.LeftIndent, key:=CStr(apar.LeftIndent)
        Next apar
        On Error GoTo 0

        SortCollection coll

        For Each itmx In coll
            List = List & vbCrLf & Application.PointsToInches(itmx)
        Next itmx

        For Each apar In Selection.Paragraphs
            For i = 1 To coll.Count
                If apar.Range.ParagraphFormat.LeftIndent = coll(i) Then
                    apar.Range.Font.Color = arrColors(i)
                    apar.Range.Comments.Add Range:=apar.Range, Text:=CStr(100 + 2 * i)
                End If
            Next i
        Next apar
    End Sub

    Sub SortCollection(coll As Collection)
        Dim i As Long
        Dim j As Long
        Dim itm As Variant
        For i = 1 To coll.Count - 1
            For j = i + 1 To coll.Count
                If coll(i) > coll(j) Then
                    itm = coll(j)
                    coll.Remove j
                    coll.Add Item:=itm, key:=CStr(itm), Before:=i
                End If
            Next j
        Next i
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Supunsam Monday, August 29, 2016 12:14 PM
    Sunday, August 28, 2016 9:27 PM
  • >>>Also I would like to know is there a way to sort the collection in ascending order. 

    According to your description, MVP Hans have supplied good solution and this issue is related to VBA. So I suggest that if you have any more issue about VBA, you could post your question on MSDN forum for Visual Basic for Applications (VBA)

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=isvvba

    >>>Another problem I'm having is when this runs in a table selection only the first comment adds. I cant really find out whats causing that.

    Could you provide more information about this issue, for example screenshot, that will help us reproduce and resolve it.

    Thanks for your understanding. 
    Monday, August 29, 2016 5:18 AM
  • Hi Hans,

    Thank you very much for this much my friend. It works. Thank you so much. But still I'm having that issue when run in a table. What could be the issue exactly ?. Instead of adding  comment to the paragraph should I add the comment to the cell itself??

    However. Thank you very much Hans.

    Regards

    ____________________

    Supun Samarakoon

    Monday, August 29, 2016 11:41 AM
  • Hi David, 

    Thank you very much for your advice. For the sorting the collection Hans's workaround works really great. But i will take it up to MSDN VBA. 

    And for the Tables issue code will run just fine. But Only first comment get added. That's the Issue. Here's screen cap of after the code is executed:

    

    Any idea what's happening here??

    Regards

    ____________________

    Supun Samarakoon

    • Edited by Supunsam Monday, August 29, 2016 11:52 AM
    Monday, August 29, 2016 11:52 AM
  • Hi Guys,

    I think I was able to find whats wrong when running with tables. I was playing with my genius friend Hans's Code and i found a solution. Thank you very much Hans. Finally I would like to know instead of selecting the table can I run this for the first column in every table??

    Option Explicit
    
    Sub ListIndents()
        Dim apar As Paragraph
        Dim oTable As Table
        Dim ocell As Cell
        Dim coll As New Collection
        Dim itmx As Variant
        Dim List As String
        Dim i As Long
        Dim arrColors(1 To 8) As Long
    
        arrColors(1) = vbBlack
        arrColors(2) = vbBlue
        arrColors(3) = vbGreen
        arrColors(4) = vbRed
        arrColors(5) = vbYellow
        arrColors(6) = vbCyan
        arrColors(7) = vbMagenta
        arrColors(8) = RGB(128, 128, 128)
    
        On Error Resume Next
        For Each apar In Selection.Paragraphs
            coll.Add Item:=apar.LeftIndent, Key:=CStr(apar.LeftIndent)
        Next apar
        On Error GoTo 0
    
        SortCollection coll
    
        For Each itmx In coll
            List = List & vbCrLf & Application.PointsToInches(itmx)
        Next itmx
    
    
        For Each ocell In Selection.Cells
            For i = 1 To coll.Count
                If ocell.Range.ParagraphFormat.LeftIndent = coll(i) Then
                    ocell.Range.Font.Color = arrColors(i)
                    ocell.Range.Comments.Add Range:=ocell.Range, Text:=CStr(100 + 2 * i)
                End If
            Next i
        Next ocell
    
    End Sub
    
    Sub SortCollection(coll As Collection)
        Dim i As Long
        Dim j As Long
        Dim itm As Variant
        For i = 1 To coll.Count - 1
            For j = i + 1 To coll.Count
                If coll(i) > coll(j) Then
                    itm = coll(j)
                    coll.Remove j
                    coll.Add Item:=itm, Key:=CStr(itm), Before:=i
                End If
            Next j
        Next i
    End Sub
    
    

    Regards

    _________________

    Supun Samarakoon

    Monday, August 29, 2016 12:18 PM
  • You could add a check in the For Each ocell ... Next ocell loop:

        For Each ocell In Selection.Cells
            If ocell.ColumnIndex = 1 Then
               
    For i = 1 To coll.Count
                   
    If ocell.Range.ParagraphFormat.LeftIndent = coll(i) Then
                        ocell
    .Range.Font.Color = arrColors(i)
                        ocell
    .Range.Comments.Add Range:=ocell.Range, Text:=CStr(100 + 2 * i)
                   
    End If
               
    Next I
            End If
       
    Next ocell


    Regards, Hans Vogelaar (http://www.eileenslounge.com)



    Monday, August 29, 2016 2:06 PM
  • Thank you very much Hans. That totally works. Thank you so much for your help.

    Regards,

    _______________________

    Supun Samarakoon

    Monday, August 29, 2016 2:29 PM