How to Find and Move Pictures and Captions from One Document to Others

Recently on the Microsoft Community Forum a Microsoft 365 Word user asked for help creating a macro that would find all pictures they had in a document and put each picture into a separate document along with the picture’s caption. They also wanted to name each new document the caption name label. For example, a picture with the caption label of “Figure 1” would be copied into a new Word document and the new document’s filename would become “Figure 1.docx.”

Taking a critical look at the requirements for this macro, a few questions arise.

  1. Is the caption above or below each image?

  2. Does the macro search for pictures or captions?

  3. Are the pictures placed inline on their own paragraph or is there wrapping text around them?

  4. If using the Caption text for the resultant filename, what happens if there are special characters in the Caption that Windows does not allow in filenames?

  5. If only the Caption label and number are used for the filename, what happens when the macro tries to save the new file and there already exists a file called Figure #?

Whenever you create a macro that will automate repetitive tasks, you have to think about various possible scenarios that may arise and either allow for them in the macro’s code or define the source data requirements … in this case, what are we expecting to find in the source document’s formatting, and if the unexpected happens, how do we handle it?

VBA CODE to Find and Move Pictures and Captions from One Document to Others

The following is the VBA code I wrote that performs the task the Microsoft 365 Word user requested. Interspersed throughout the code are comments that explain what is being done and why. In other words, based on those five questions I shared above, I am showing you my thought process and logic. Comments in VBA code all begin with a single quote mark, and I’ve colored the comment text green. Please note that the text strings in double quotation marks are also showing as green, but anything in double quotation marks are part of the code (not comments.) 

Sub DocumentMaker()
    Const MacroName = "AuthorTec™ Document Maker"
    
    'Authored by Richard V Michaels, Microsoft Office Services MVP
    'Chief Product Architect of Great Circle Learning, Inc.
    'https://www.greatcirclelearning.com
    'AuthorTec is a Trademark of Richard V Michaels
    
    Dim rng As Word.Range
    Dim strFolderName As String, CaptionString() As String
    Dim NewDocsFolder As String
    Dim orgDoc As Word.Document, orgPath As String, orgName As String, NewDoc As Word.Document
    
    'When the unexpected happens, an error code is generated, and a message will be provided
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    'The documents being created are saved into a special subfolder of where the source document is located. This should prevent accidental duplicate filenames and keep everything organized.
    Set orgDoc = ActiveDocument
    orgName = orgDoc.FullName
    orgPath = orgDoc.path & Application.PathSeparator
    strFolderName = VBA.Left(orgDoc.Name, InStrRev(orgDoc.Name, ".") - 1) & "_ATec_NewDocs"
    NewDocsFolder = orgPath & strFolderName & Application.PathSeparator
    If Dir(NewDocsFolder, vbDirectory) = vbNullString Then
        MkDir NewDocsFolder
    End If
    
    'The following code searches for the StyleName of "Caption" we will only work with
    'Pictures that have Captions.
    Set rng = orgDoc.Content
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .Style = ActiveDocument.Styles("Caption").NameLocal
        .Text = ""
        .Wrap = wdFindStop
        While .Execute
            'When a Caption Style is found we use only the label and caption number.
            'This is accomplished using the Split method of VBA. We split the caption
            'at the colon character that follows the caption number. Colons characters
            'cannot be used in a Windows filename.
            CaptionString = Split(rng.Text, ":")
            'Next we figure out if the Caption is above or below the picture. We are also
            'only looking for pictures that are inline with text. Due to the difficulty of having
            'Pictures with wrapping text and Captions, we decided not to try and deal with them
            'in this macro.
            rng.MoveStart Word.WdUnits.wdCharacter, Count:=-2
            If rng.InlineShapes.Count = 0 Then
                rng.MoveStart Word.WdUnits.wdCharacter, Count:=2
                rng.MoveEnd Word.WdUnits.wdCharacter, Count:=2
            End If
            If rng.InlineShapes.Count > 0 Then
                'Now that we have located a picture and its Caption, we start a new Word document
                'add the Picture and Caption to it, and save it into the special folder we created,
                'using the Caption label and number as the document name.
                Set NewDoc = Documents.Add
                NewDoc.Content.FormattedText = rng.FormattedText
                NewDoc.SaveAs2 FileName:=NewDocsFolder & CaptionString(0), AddToRecentFiles:=False, FileFormat:=Word.WdSaveFormat.wdFormatDocumentDefault
                NewDoc.Close
            End If
            rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            'This routine will keep looping so to find all Pictures with Captions in the source document.
        Wend
    End With

ErrHandler:
    'If an unexpected error occurs in the above code, a message is generated so the problem can be analyzed and fixed.
    'If there are no errors then an Action Complete message is displayed, and the macro ends successfully.
    If Err.Number > 0 Then
        MsgBox Err.Number & vbCr & Err.Description, vbCritical, MacroName
        Err.Clear
    Else
        MsgBox "Action Complete", vbOK, MacroName
    End If
    Application.ScreenUpdating = True
End Sub

 

 To sum up

Whenever you create a macro to automate repetitive tasks:

  1. Consider the possible scenarios that may arise.

  2. Allow for them in the macro’s code.

  3. Or define the source data requirements … and if the unexpected happens, how is that handled?

To be alerted when we add posts like this please join our list and select Custom Solutions as one of your interests.

 

For help with a custom code solution, please contact us with a description of your need.