A Makro for automatically insert captions for specific letters

Lydia90 · #1 10-15-2023, 07:47 AM

Hey there,

I'm new here.

I'm trying to write a macro that searches an entire Word document for
a specific order of
letters (for exaple "XYZ") and replaces/adds automatic captions to them.

I have very big documents with plain text and without any captions.
it takes to much time to add the captions manual.

iam beging you for some help

vivka · #2 10-15-2023, 09:27 AM

Hi, Lydia90! It's not difficult, but some details are needed: Do you want to get XYZ (as one word) or X and Y and Z capital? Do these letters begin new sentences (are they preceded by space and a period/full stop)? Or better, could you upload an example file here?

Lydia90 · #3 10-16-2023, 12:32 AM

Hi vivka

XYZ as one word. The letter do not beginn new sentences.

Its something like these:
"The following Figure XYZ presents a Picture of the States in our Country."

or
"Figure XYZ: The States in our Country"

I want to replace all these placeholders with the captions.

later I want to add a figure directory at the beginning of the document, in which also the title of the figure (for example "The States in our Country") appears.

The figure directory should look like this;
Figure 1: The States in our Country
Figure 2: The States in our Country, details
Figure 3: The Country
...

vivka · #4 10-16-2023, 01:32 PM

Hi, Lydia90! The code is simple and it does what you want. I added an inputbox in case you want to find sth else. Selection allows working on any selected range incl. the active document (Ctrl+A)

Code:

Sub Uppercase_Stri()
'In slection, find all instances of the inputboxed string
'and capitalize all their letters.

Dim myRng As range
Dim stri As String

Set myRng = selection.range
    stri = InputBox("Enter the string to find")
    With myRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = stri
        .Replacement.Font.AllCaps = True
        .Forward = True
        .Format = True
        .MatchCase = True
        .MatchWholeWord = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .MatchWildcards = False
        .Wrap = wdFindStop
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Lydia90 · #5 10-18-2023, 03:01 AM

Hey vivka,
that seems not to work for me. am i doing something wrong?
when i start the makro, enter a string and press "ok", nothing happen.

vivka · #6 10-18-2023, 03:24 AM

Hi! Did you select the text before running the macro? If you want it to work on the whole document, press Ctrl+A keys together.

Lydia90 · #7 10-18-2023, 04:47 AM

yes, thats what i did.
the selected string just turns into capital letters. thats all.

just for clarity:

the selected string should be the numbering for the figures.
for example:

"Figure XYZ, Figure XYZ, Figure XYZ" should turn into ""Figure 1, Figure 2, Figure 3"

vivka · #8 10-18-2023, 05:11 AM

Lydia90, but you asked for a macro to convert all instances of a specific string to caps (post 1). And this macro does it! Do you want to get xyz replaced with sequential numbers? In order to avoid misunderstandings, could you post here a part of your text?

vivka · #9 10-18-2023, 05:29 AM

Lydia90, the following code replaces all instances of the inputboxed string with sequential numbers starting from the number you choose (no need to change all xyz to XYZ).

Code:

Sub Uppercase_Stri()
'In slection, find all instances of the inputboxed string
'and replace them with sequential numbers.

Dim myRng As range
Dim stri As String
Dim i As String

Application.ScreenUpdating = False

Set myRng = selection.range
    stri = InputBox("Enter the string to find")
    i = InputBox("Enter the number to start counting from")
    With myRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = stri
        .Forward = True
        .Wrap = wdFindStop
        Do
            If .Execute And myRng.InRange(selection.range) Then
                i = i + 1
                myRng = i
            Else: Exit Do
            End If
            myRng.Collapse
        Loop
    End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

Lydia90 · #10 10-18-2023, 08:26 AM

hi vivka,
thanks for your help! that works so far, but: the numbers are just text. i cannot generated a Table of Figures from them / update them automatical. they are no captions.

vivka · #11 10-18-2023, 10:36 AM

Lydia90, the following macro replaces all "Figure (your inputboxed txt)" with "Figure (sequential number)" and makes them captions in the selected range.

Code:

Sub Repl_Stri_W_Sequential_Nums()
'In slection, replace all instances of the inputboxed string
'with sequential numbers / add sequential numbers after each
'instance of the inputboxed string.

Dim myRng As range
Dim stri As String
Dim i As String

Application.ScreenUpdating = False

Set myRng = selection.range
    stri = InputBox("Enter the string to find")
    i = InputBox("Enter the number to start counting from")
    With myRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = "Figure " & stri
        .Forward = True
        .Wrap = wdFindStop
        Do
            If .Execute And myRng.InRange(selection.range) Then
                i = i + 1
                myRng = "Figure " & i
                myRng.Style = wdStyleCaption
            Else: Exit Do
            End If
            myRng.Collapse wdCollapseEnd
        Loop
    End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

Lydia90 · #12 10-20-2023, 12:30 AM

hmm, no. nothing happens.

vivka · #13 10-20-2023, 01:50 AM

Sorry, Lydia90! You are right. I've only styled the captions as captions but haven't made them actual captions.

vivka · #14 10-20-2023, 02:50 AM

It is even simpler:

Code:

Sub Repl_Stri_W_Sequential_Nums()
'In slection, replace all instances of the inputboxed string
'with captions.

Dim myRng As range
Dim stri As String

Application.ScreenUpdating = False

Set myRng = selection.range
    stri = InputBox("Enter the string to find")
    With myRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = "Figure " & stri
        .Forward = True
        .Wrap = wdFindStop
        Do
            If .Execute And myRng.InRange(selection.range) Then
                myRng.Delete
                myRng.InsertCaption label:="Figure", _
                    TitleAutoText:="", _
                    Title:="", _
                    Position:=wdCaptionPositionBelow, _
                    ExcludeLabel:=0
            Else: Exit Do
            End If
            myRng.Collapse wdCollapseEnd
        Loop
    End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA to insert captions without appending to existing captions	Marrick13	Word VBA	17	03-21-2023 07:51 PM
Insert Captions and Word Wrap	TEAllred	Word	1	11-22-2015 03:21 PM
Captions: Changing captions in Appendix update all captions	carnestw	Word	3	10-27-2015 12:34 PM
Captions automatically updating all previous entries	jhats	Word	1	07-29-2014 11:53 PM
Captions mixing letters and numbers	trew	Word	7	11-21-2012 12:54 AM