Output at the end of the text of all links using VBA

Yarandlo · #1 02-17-2023, 06:03 AM

Hi everybody.

I write a lot of text, and in scientific publications I often indicate references in the form [1] [2] [3]. When there are a lot of them (more than a hundred), it is very difficult to manually check whether the numbering order has been lost. Please help me with a macro so that after running the macro at the end of the text it displays all the links, so that I can then check if I followed the correct numbering of the links.

For example, it went like this:

Some text [1]. Text [2]. More text [3]. Text [4]. Text [5]. And so on…

And this is how it should be after running the macro:

Some text [1]. Text [2]. More text [3]. Text [4]. Text [5]. And so on…

[1] [2] [3] [4] [5]

gmayor · #2 02-17-2023, 07:01 AM

It might make more sense for the future to use automatic numbering so you won't have the problem with missed references, however

Code:

Sub Macro1()
Dim oRng As Range
Dim sText As String
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        Do While .Execute(findText:="\[[0-9]{1,}\]", _
                          MatchWildcards:=True, _
                          Wrap:=wdFindStop, _
                          Forward:=True) = True
            Set oRng = Selection.Range
            sText = sText & oRng.Text & Chr(32)
        Loop
    End With
    ActiveDocument.Range.InsertAfter vbCr & sText
lbl_Exit:
    Exit Sub
End Sub

Yarandlo · #3 02-18-2023, 07:46 AM

Thanks for the automated links tip.

gmayor · #4 02-18-2023, 10:33 PM

Given that you are attracted to autonumbering as suggested, the following macros will address that. The first replaces your numbered items with Sequence fields. The second will add a number using the same sequence and update the sequence to reflect the addition.

Code:

Sub ReplaceNumbers()
Dim oRng As Range
    ActiveWindow.ActivePane.View.ShowFieldCodes = True
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="\[[0-9]{1,}\]", _
                          MatchWildcards:=True, _
                          Wrap:=wdFindStop, _
                          Forward:=True) = True
            oRng.Fields.Add oRng, wdFieldSequence, "List\# ""'['0']'""", False
            oRng.Collapse 0
        Loop
    End With
    ActiveWindow.ActivePane.View.ShowFieldCodes = False
lbl_Exit:
Set oRng = Nothing
    Exit Sub
End Sub

Sub AddNumber()
Dim oRng As Range
Dim oField As Field
    ActiveWindow.ActivePane.View.ShowFieldCodes = True
    Set oRng = Selection.Range
    oRng.Fields.Add oRng, wdFieldSequence, "List\# ""'['0']'""", False
    oRng.Collapse 0
    ActiveWindow.ActivePane.View.ShowFieldCodes = False
    For Each oRng In ActiveDocument.StoryRanges
        For Each oField In oRng.Fields
            oField.Update
        Next oField
    Next oRng
lbl_Exit:
    Set oRng = Nothing
    Set oField = Nothing
    Exit Sub
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Userform to output specific text	~clover	Word VBA	2	06-01-2019 07:04 AM
Content Control Listbox output to text box possible?	VGW	Word VBA	2	07-05-2018 04:18 PM
Outlook Template: Trying to Output text and fields	back2ict	Outlook	0	07-03-2018 08:57 AM
How do I output text to a specific cell (x,y)?	norwood	Word VBA	2	01-31-2014 08:43 AM
Generating text output from PowerPoint picture/name slides	bornslippy	PowerPoint	2	12-05-2013 11:04 AM