none
Replace all images in Word document into new ones RRS feed

  • Question

  • Hello, 

    I am quite fresh to Word VBA object model, and i have a problem:

    On my Word document I have many pages. On much page I have picture inserted.
    I want to replace old picture by new one in the same place where the old was.

    Is it possible to find and replace pictures by their caption? I have excel file with caption | site number | path to new images.

    (I use Word 2016)
    Monday, October 9, 2017 9:07 AM

Answers

  • Try the following Excel macro:

    Sub BulkImageUpdate()
    Dim wdApp As Object, wdDoc As Object, wdIShp As Object, wdRng As Object
    Dim xlWkSht As Worksheet, lRow As Long, r As Long, sngHght As Single
    Const wdDialogFileOpen As Long = 80: Const wdFindContinue As Long = 1: Const wdWord As Long = 2
    Set xlWkSht = ActiveSheet
    With xlWkSht
      lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    On Error Resume Next
    Set wdApp = CreateObject("Word.Application")
    If wdApp Is Nothing Then
      MsgBox "Can't start Word.", vbExclamation
      Exit Sub
    End If
    On Error GoTo 0
    With wdApp
      .Visible = True
      With .Dialogs(wdDialogFileOpen)
        If .Show = -1 Then
        .Update
        Set wdDoc = wdApp.ActiveDocument
        End If
      End With
      If Not wdDoc Is Nothing Then
        With wdDoc
          For r = 1 To lRow
            With .Range
              With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .MatchCase = True
                .Format = True
                .Style = "Caption"
                .Wrap = wdFindContinue
                .Text = xlWkSht.Range("A" & r).Value
                .Execute
              End With
              If .Find.Found = True Then
                While .Inlineshapes.Count = 0
                  .MoveStart wdWord, -1
                Wend
                With .Inlineshapes(1)
                  Set wdRng = .Range
                  sngHght = .Height
                  .Delete
                End With
                Set wdIShp = .Inlineshapes.AddPicture(xlWkSht.Range("C" & r).Value, False, True, wdRng)
                wdIShp.Height = sngHght
              End If
            End With
          Next
          .Close True
        End With
      End If
      .Quit
    End With
    Set wdIShp = Nothing: Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
    Application.ScreenUpdating = True
    End Sub
    As coded, it is assumed the captions are in column A and the file names & paths are in column C. I don't know what you intend the 'site number' to be used for.


    Cheers
    Paul Edstein
    [MS MVP - Word]



    • Edited by macropodMVP Tuesday, October 10, 2017 9:16 AM
    • Proposed as answer by Chenchen LiModerator Thursday, October 12, 2017 7:30 AM
    • Marked as answer by rputt Friday, October 13, 2017 10:30 AM
    Tuesday, October 10, 2017 9:13 AM

All replies

  • 1. How are the images in the document formatted - inline or floating?

    2. Do all images have captions?

    3. Are all the captions in the document the same as in the workbook?

    4. Are the captions above, or below, the images?


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, October 10, 2017 1:05 AM
  • Hello,

    Thanks for your prompt response

    1. Inline

    2. Yes

    3. Yes

    4. Below

    Tuesday, October 10, 2017 7:37 AM
  • Try the following Excel macro:

    Sub BulkImageUpdate()
    Dim wdApp As Object, wdDoc As Object, wdIShp As Object, wdRng As Object
    Dim xlWkSht As Worksheet, lRow As Long, r As Long, sngHght As Single
    Const wdDialogFileOpen As Long = 80: Const wdFindContinue As Long = 1: Const wdWord As Long = 2
    Set xlWkSht = ActiveSheet
    With xlWkSht
      lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    On Error Resume Next
    Set wdApp = CreateObject("Word.Application")
    If wdApp Is Nothing Then
      MsgBox "Can't start Word.", vbExclamation
      Exit Sub
    End If
    On Error GoTo 0
    With wdApp
      .Visible = True
      With .Dialogs(wdDialogFileOpen)
        If .Show = -1 Then
        .Update
        Set wdDoc = wdApp.ActiveDocument
        End If
      End With
      If Not wdDoc Is Nothing Then
        With wdDoc
          For r = 1 To lRow
            With .Range
              With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .MatchCase = True
                .Format = True
                .Style = "Caption"
                .Wrap = wdFindContinue
                .Text = xlWkSht.Range("A" & r).Value
                .Execute
              End With
              If .Find.Found = True Then
                While .Inlineshapes.Count = 0
                  .MoveStart wdWord, -1
                Wend
                With .Inlineshapes(1)
                  Set wdRng = .Range
                  sngHght = .Height
                  .Delete
                End With
                Set wdIShp = .Inlineshapes.AddPicture(xlWkSht.Range("C" & r).Value, False, True, wdRng)
                wdIShp.Height = sngHght
              End If
            End With
          Next
          .Close True
        End With
      End If
      .Quit
    End With
    Set wdIShp = Nothing: Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
    Application.ScreenUpdating = True
    End Sub
    As coded, it is assumed the captions are in column A and the file names & paths are in column C. I don't know what you intend the 'site number' to be used for.


    Cheers
    Paul Edstein
    [MS MVP - Word]



    • Edited by macropodMVP Tuesday, October 10, 2017 9:16 AM
    • Proposed as answer by Chenchen LiModerator Thursday, October 12, 2017 7:30 AM
    • Marked as answer by rputt Friday, October 13, 2017 10:30 AM
    Tuesday, October 10, 2017 9:13 AM
  • Hi,

    when i try run this macro i see this:

    Did you know what is problem?

    Thursday, October 12, 2017 8:04 AM
  • Kindly post the message box's text; your image is illegible. If a code line is highlighted, tell us which one that is, too.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, October 12, 2017 9:10 AM
  • Run-time error '5834'

    Application-defined or object-defined error

    code line is not highlighted

    Thursday, October 12, 2017 10:50 AM
  • I don't get any such error. In my testing, the images are correctly replaced. Check that really do you have:
    • an inlineshape above each caption in the document.
    • caption names in column A in the worksheet
    • full paths & filenames in column C in the worksheet
    and that you are running the macro from the Excel workbook.

    PS: You might need to add:
    wdIShp.LockAspectRatio = True
    before:
    wdIShp.Height = sngHght
    to prevent distortions occurring.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, October 12, 2017 8:54 PM
  • Hi,

    Everything works perfectly, there was an mistake in the path

    Thank you for your work.
    Friday, October 13, 2017 10:30 AM