I have this macro which I get from
http://gregmaxey.com/word_tip_pages/..._methods).html
I did some modifications.
I need a workaround to two problems:
1) If the selection includes the last paragraph of the document the code returns erro in the line "Set oPar2 = oPar1.Next" (opar2 = nothing).
2) If I select to do not remove duplicates (DelRep = 0) the code does not works and enters in infinite loop.
Thanks
Code:
Sub SortRemoveAndTrackDuplicates2()
Dim oPars As Paragraphs, oPar1 As Paragraph, oPar2 As Paragraph, oRng As Range, i As Long, NumOc As Integer, DelRep As Integer
Set oPars = Selection.Range.Paragraphs
If oPars.Count > 1 Then
Selection.Sort SortOrder:=wdSortOrderAscending
Else
MsgBox "Não há seleção válida para classificar!", vbCritical, " ERRO!"
Exit Sub
End If
If Selection.Information(wdWithInTable) Then
MsgBox "Please move items to sort from table. You can move them back into" _
& " a table after sorting."
Exit Sub
End If
NumOc = IIf(MsgBox("Inserir número de ocorrências?", vbYesNo, " NÚMERO DE OCORRÊNCIAS?") = vbYes, 1, 0)
DelRep = IIf(MsgBox("Remover itens duplicados?", vbYesNo, " REMOVER DUPLICADAS?") = vbYes, 1, 0)
Set oPar1 = oPars.Item(1)
Do
i = 1
Do
Set oPar2 = oPar1.Next
If oPar2.Range.Text = oPar1.Range.Text Then
i = i + 1
If DelRep = 1 Then oPar2.Range.Delete
Else
Exit Do
End If
Loop
Set oRng = oPar1.Range
oRng.End = oRng.End - 1
If NumOc = 1 Then oRng.InsertAfter " (" & CStr(i) & ")"
If oPar1.Range.End = oPars.Last.Range.End Then Exit Do
Set oPar1 = oPar2
Loop
End Sub