Sub ReplaceShapeInMultipleDocuments()

    Dim folderPath As String
    Dim fileInFolder As String
    Dim doc As Document
    Dim dialogFolder As FileDialog
    
    ' Create a FileDialog object as a Folder Picker dialog box
    Set dialogFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' Allow the user to select multiple folders
    dialogFolder.AllowMultiSelect = True
    
    ' Show the dialog box
    If dialogFolder.Show = -1 Then
        ' Loop through each selected folder
        For i = 1 To dialogFolder.SelectedItems.Count
            ' Get the path of the folder
            folderPath = dialogFolder.SelectedItems(i)
            
            ' Get the first .docx file in the folder
            fileInFolder = Dir(folderPath & "\*.docx", vbNormal)
            
            ' Loop through each .docx file in the folder
            While fileInFolder <> ""
                ' Open the document
                Set doc = Documents.Open(folderPath & "\" & fileInFolder)
                
                ' Call the ReplaceShapeWithImage macro
                ReplaceShapeWithImage doc
                
                ' Close the document and save the changes
                doc.Close SaveChanges:=wdSaveChanges
                
                ' Get the next .docx file in the folder
                fileInFolder = Dir()
            Wend
        Next i
    End If
End Sub

Sub ReplaceShapeWithImage(doc As Document)
    Dim shp As Shape
    Dim imagePath As String
    Dim width As Single
    Dim height As Single
    
    ' Set the path to your image
    imagePath = "C:\Q.png"
    
    ' Prompt the user to input the size of the image
    width = 100
    height = 20
    
    ' Loop through each section in the document
    For Each sec In doc.Sections
        ' Loop through each header in each section
        For Each hdr In sec.Headers
            ' Loop through each shape in each header
            For Each shp In hdr.Shapes
                ' Check if the shape is the one we want to replace
                If shp.Name = "Rectangle 197" Then
                    ' Delete the old shape
                    shp.Delete
                    
                    ' Add the new image
                    Set shp = hdr.Shapes.AddPicture(imagePath, False, True, 0, 0, width, height)
                    
                    ' Set the name of the new shape to the old shape's name
                    shp.Name = "Rectangle 197"
                    
                    ' Center the image in the header
                    shp.Left = (hdr.Range.Sections(1).PageSetup.PageWidth - shp.width) / 2
                    
                    ' Exit the sub after replacing the shape
                    Exit Sub
                End If
            Next shp
        Next hdr
    Next sec
End Sub