MS Word macro to delete a specific picture in the document?

[musicgold]

Hi,

Is there a way to find a specific image in a word document and delete it? I about 20 or so Word documents and there is an image in each of them with a title Figure 11. As shown below, while I am able to loop through all open documents and reach to Figure 11, I am not able to delete the image inside the table.

Thanks

 

[Macropod]

Since you haven't posed any code - especially the code that locates the table - it's impossible to say what specific changes need to be made to that code.

 

[musicgold]

Since you haven't posed any code - especially the code that locates the table - it's impossible to say what specific changes need to be made to that code.

Here is the code. I want to be able to delete the picture in the table.

 If doc.Name <> strName Then

    doc.Select
    
Selection.Find.Replacement.ClearFormatting

    With Selection.Find
        .Text = "Figure 11."
        .Replacement.Text = "Figure 11. Star Table*"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
  End If

 

[Macropod]

For excample:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
Do While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = "Figure 11."
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchWildcards = True
        End With
        Do While .Find.Execute
          If .Information(wdWithInTable) = True Then
            .Cells(1).Range.Text = "Figure 11. Star Table*"
            .Start = .Cells(1).Range.End
          End If
          .Collapse wdCollapseEnd
        Loop
      End With
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Loop
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function