none
Find Word Styles and add comment for each RRS feed

  • Question

  • Hi,

    I have to create a macro to find all styles except 'Normal' and 'Normal (Web)'. And then I've to mark all other styles as MS Word comment (Ex: Style Used).

    I've tried the following to select all styles except 'Normal' and 'Normal (Web)'.

    Sub Test()
    Dim opar As Paragraph
    Application.ScreenUpdating = False
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
       For Each opar In ActiveDocument.Paragraphs
           If opar.Style = ActiveDocument.Styles(wdStyleNormal) Then
       Else
           opar.Range.Editors.Add wdEditorEveryone
       End If
    Next
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    Application.ScreenUpdating = True
    End Sub

    So, How do I mark all of the styles as comment. Any idea much appreciate.

    .

    Tuesday, August 9, 2016 1:22 PM

Answers

  • This might do what you want:

    Option Explicit
    Const MESSAGE = "Style="
    Sub Test()
        Dim oPar As Paragraph
        Dim oCom As Comment

        Application.ScreenUpdating = False
        ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
        For Each oCom In ActiveDocument.Comments
            'Optionally delete all comments made by person with the specified initials
            '        If oCom.Initial = "XXX" Then
            oCom.Delete
            '        End If
        Next oCom
        For Each oPar In ActiveDocument.Paragraphs
            If oPar.Style <> ActiveDocument.Styles(wdStyleNormal) Then
                ActiveDocument.Comments.Add oPar.Range, MESSAGE & oPar.Style
            End If
        Next oPar
        ActiveDocument.SelectAllEditableRanges wdEditorEveryone
        ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
        Application.ScreenUpdating = True
    End Sub


    Best regards, George

    • Marked as answer by Sam1085 Tuesday, August 9, 2016 1:53 PM
    Tuesday, August 9, 2016 1:40 PM

All replies

  • This might do what you want:

    Option Explicit
    Const MESSAGE = "Style="
    Sub Test()
        Dim oPar As Paragraph
        Dim oCom As Comment

        Application.ScreenUpdating = False
        ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
        For Each oCom In ActiveDocument.Comments
            'Optionally delete all comments made by person with the specified initials
            '        If oCom.Initial = "XXX" Then
            oCom.Delete
            '        End If
        Next oCom
        For Each oPar In ActiveDocument.Paragraphs
            If oPar.Style <> ActiveDocument.Styles(wdStyleNormal) Then
                ActiveDocument.Comments.Add oPar.Range, MESSAGE & oPar.Style
            End If
        Next oPar
        ActiveDocument.SelectAllEditableRanges wdEditorEveryone
        ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
        Application.ScreenUpdating = True
    End Sub


    Best regards, George

    • Marked as answer by Sam1085 Tuesday, August 9, 2016 1:53 PM
    Tuesday, August 9, 2016 1:40 PM
  • Hi George,

    Wow this is awesome. Thanks!


    .

    Tuesday, August 9, 2016 1:54 PM