Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-14-2017, 02:42 PM
eduzs eduzs is offline Some problems in this script Windows 10 Some problems in this script Office 2010 32bit
Expert
Some problems in this script
 
Join Date: May 2017
Posts: 255
eduzs is on a distinguished road
Default 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
Reply With Quote
  #2  
Old 05-15-2017, 01:37 AM
macropod's Avatar
macropod macropod is offline Some problems in this script Windows 7 64bit Some problems in this script Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,698
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #3  
Old 05-15-2017, 03:38 AM
eduzs eduzs is offline Some problems in this script Windows 10 Some problems in this script Office 2010 32bit
Expert
Some problems in this script
 
Join Date: May 2017
Posts: 255
eduzs is on a distinguished road
Default

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
For the 2nd problem:

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
Now I can I can now choose if I want numbering and/or exclude duplicates.

Thanks
Reply With Quote
  #4  
Old 05-17-2017, 06:42 AM
eduzs eduzs is offline Some problems in this script Windows 10 Some problems in this script Office 2010 32bit
Expert
Some problems in this script
 
Join Date: May 2017
Posts: 255
eduzs is on a distinguished road
Default

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.
Reply With Quote
  #5  
Old 05-17-2017, 04:14 PM
macropod's Avatar
macropod macropod is offline Some problems in this script Windows 7 64bit Some problems in this script Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,698
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

No, we don't delete threads unless there are good reasons for doing so.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Script Template __John__ Word 0 06-24-2016 02:41 PM
Some problems in this script 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

Other Forums: Access Forums

All times are GMT -7. The time now is 04:11 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2022, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2022 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft