#1
|
|||
|
|||
Some problems in this script
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 |
#2
|
||||
|
||||
Cross-posted at: https://www.mrexcel.com/forum/genera...-problems.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
I've found a solution myself.
For the 1st problem, I didn't found a solution, just stop the code if Selection.Range.Paragraphs.Count = ActiveDocument.Paragraphs.Count Code:
If oPars.Count > 1 And Selection.Range.Paragraphs.Count < ActiveDocument.Paragraphs.Count Then Selection.Sort SortOrder:=wdSortOrderAscending Else MsgBox "Não há seleção válida para classificar!", vbCritical, " ERRO!" Exit Sub End If Code:
If oPar2.Range.Text = oPar1.Range.Text Then i = i + 1 If DelRep = 1 Then oPar2.Range.Delete Else Set oPar2 = oPar1.Next Exit Do End If Else Exit Do End If Thanks |
#4
|
|||
|
|||
It"s possible to delete this thread? Thanks
Hello administrators, please delete this thread. Thanks Last edited by eduzs; 05-17-2017 at 03:34 PM. |
#5
|
||||
|
||||
No, we don't delete threads unless there are good reasons for doing so.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Script Template | __John__ | Word | 0 | 06-24-2016 02:41 PM |
Outlook VBA Script | kcm5153 | Outlook | 1 | 04-07-2015 11:41 PM |
Bolding in script | ksigcajun | Word VBA | 10 | 02-23-2015 08:29 AM |
Help with VBA script | nsyrax | Word VBA | 1 | 01-18-2014 03:38 AM |
[ask] about VB Script + Ms. Project | anak_baru | Project | 2 | 03-10-2009 01:42 AM |