0 votes
in VBA by Beginner (5 points)

I am a beginer, obviously blush and I need a little help with this situation:

In a text like:

Article I:

(the text of the article)

Article II:

(the text of the article)

...

Article n:

(the text of the article)

I need a macro to replace Article I: to Article n: with Art. 1 to Art. n so the end result is

Art. 1

(the text of the article)

Art. 2

(the text of the article)

...

Art. n

(the text of the article)

If you have any idea how to do that, I would greatly appreciate it, because we have texts that have a few articles and texts that have thousands of articles and it is hell to replace each one.

Thank you!

2 Answers

+1 vote
by Skilled (366 points)
selected by
 
Best answer

This macro assumes there are no spaces or other characters after the colon in Article I: or Article II: or etc., and it assumes that Art. numbers are consecutive starting at 1. Any sentence that includes text like Article I: or Article II: or etc. must have a space or other character after the colon; otherwise, that text might be converted inappropriately.

Sub ArticleToArt()
    n = 0
    i = 1
    With ActiveDocument
        Do While i <= (.Words.Count - 2)
            If .Words(i).Text = "Article " And .Words(i + 2).Text = ":" Then
                n = n + 1
                .Words(i + 2).Delete
                .Words(i + 1).Delete
                .Words(i).Text = "Art"
                .Words(i).InsertAfter ". " & CStr(n)
                i = i + 3
            Else
                i = i + 1
            End If
        Loop
    End With
End Sub

 

by Beginner (5 points)

Thank you very much! laugh

by Beginner (0 points)
I have the same problem only that I need Article I: to be Art. I and Article 1: to be Art. 1!

It would help me a great deal, thank you
by Skilled (366 points)
The previous macro will work for that, too.
0 votes
by Skilled (366 points)
edited by

This works better than my previous answer. The previous assumptions are no longer necessary.

Sub ArticleToArt()
' Replace Article N or Article N: with Art. A where N is Roman Numeral or Arabic and A is Arabic
    Dim i As Integer, s As String, n As Long
    Const sBefore As String = "Article "
    Const sAfter As String = "Art. "
    i = 1
    With ActiveDocument                 
    ' or With Selection instead of ActiveDocument
        Do While i <= (.Words.Count - 2)
            If Left(.Words(i).Text, Len(sBefore)) = sBefore Then
                s = Trim(.Words(i + 1).Text)
                If IsNumeric(s) Then
                    n = CLng(s)
                Else
                    n = RomanToArabic(s)
                End If
                If n > 0 Then
                    s = sAfter & n
                    If Left(.Words(i + 2).Text, 1) = ":" Then
                        s = s & Mid(.Words(i + 2).Text, 2)
                        .Words(i + 1).Text = .Words(i + 1).Text & " "
                        .Words(i + 2).Delete
                    End If
                    s = s & Space(Len(.Words(i + 1).Text) - Len(Trim(.Words(i + 1).Text)))
                    .Words(i + 1).Delete
                    .Words(i).Text = s
                End If
            End If
            i = i + 1
        Loop
    End With
End Sub

Function RomanToArabic(ByVal roman As String) As Long
' Return the Roman Numeral converted to Arabic, or zero if error
' see https://www.vb-helper.com/howto_roman_arabic.html
    Dim i As Integer, ch As String, result As Long
    Dim new_value As Long, old_value As Long
    roman = UCase(roman)
    old_value = 1000
    For i = 1 To Len(roman)
        ch = Mid(roman, i, 1)
        ' What is this character worth
        Select Case ch
            Case "I": new_value = 1
            Case "V": new_value = 5
            Case "X": new_value = 10
            Case "L": new_value = 50
            Case "C": new_value = 100
            Case "D": new_value = 500
            Case "M": new_value = 1000
            Case Else: RomanToArabic = 0: Exit Function
        End Select
        ' Is this character bigger than previous
        If new_value > old_value Then
            ' Add this and subtract 2*previous
            result = result + new_value - 2 * old_value
        Else
           ' Add this
            result = result + new_value
        End If
        old_value = new_value
    Next i
    RomanToArabic = result
End Function

 

by Beginner (5 points)
Hey, thank you for your help, works great for what I need.

I think that Legal _Crazy meant to ask how to write the macro keeping roman numerals roman and arabic numerals arabic and just change Article into Art. and remove the ":" at the end, no matter how many articles there are in a text.

Anyway, you are kind to help us!

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...