CODEWITHSUNDEEP
vbams-wordmacroscaption
Mohammad
Mohammad

Reputation: 7418

How to add table captions in MS Word using macros

I am trying to amend captions to 100 existing tables in MS Word. To avoid this tedious process I was hoping to use the built-in VB macro functionality.

If my table is inside the contents of the document in the section of:

  1. Intro
    1.1 Goals

I want the table caption to be amended with "Intro - Goals". If the table caption is already 'Table 1-1' I want it to read:

Table 1-1 Intro Goals

after the macro runs, is that possible? How?

Upvotes: 0

Views: 950

Answers (1)

ASH
ASH

Reputation: 20302

The script below is a batch process that does a find/replace routine on all the Word files in a folder. 

Sub FindReplaceAll()
    Dim MyDialog As FileDialog, GetStr(1 To 100) As String 
'100 files is the maximum applying this code
    On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
        .Filters.Clear
        .AllowMultiSelect = True
        i = 1
        If .Show = -1 Then
            For Each stiSelectedItem In .SelectedItems
                GetStr(i) = stiSelectedItem
                i = i + 1
            Next
            i = i - 1
        End If
        Application.ScreenUpdating = False
        For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
            Selection.Find.ClearFormatting
            Selection.Find.Replacement.ClearFormatting
            With Selection.Find
                .Text = "Marriott International" 'Find What
                .Replacement.Text = "Marriott" 'Replace With
                .Forward = True
                .Wrap = wdFindAsk
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
ActiveDocument.Save
            ActiveWindow.Close
        Next
        Application.ScreenUpdating = True
    End With
    MsgBox "operation end, please view", vbInformation
End Sub

' The idea comes from here.

' https://www.extendoffice.com/documents/word/1002-word-replace-multiple-files.html

Upvotes: 1

Related Questions