issue with PDF to word creating anchored objects

[mikewi]

Hey guys not sure if this is possible but when I'm using word to open a PDF it is creating anchored objects. Generally anything that isn't text like a line or watermark get changed into anchored object. I need to delete all of these and it takes considerable time and they're hard to find sometimes. Sometimes the object is in the body of the document and sometimes it anchors to the header or footer. Is there a way to run a VBA script to find each anchored object and give me the choice of deleting? Feed back is appreciated.

[gmayor]

Converting PDF to Word with Word 2013 and later is always going to be somewhat hit and miss.

The following macro will loop through all the shapes in a document and give the option to delete the selected shape, however if you delete the shape the process loses track of where it is up to and so may not find all the shapes in one pass. If you just view the shapes it tends to find them all.

Option Explicit

Sub DeleteShapes()
'Graham Mayor - http://www.gmayor.com - 16/11/2016
Dim oShape As Shape
Dim oStory As Range
For Each oStory In ActiveDocument.StoryRanges
For Each oShape In oStory.ShapeRange
oShape.Anchor.Select
If MsgBox("Delete the selected shape?", vbYesNo) = vbYes Then
oShape.Delete
End If
Next oShape
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
For Each oShape In oStory.ShapeRange
oShape.Anchor.Select
If MsgBox("Delete the selected shape?", vbYesNo) = vbYes Then
oShape.Delete
End If
Next oShape
Wend
End If
Next oStory
lbl_Exit:
Set oShape = Nothing
Set oStory = Nothing
Exit Sub
End Sub

[gmaxey]

Graham,

This should keep if from losing track:


Sub DeleteShapes()
'Graham Mayor - http://www.gmayor.com - 16/11/2016
Dim oShape As Shape
Dim oStory As Range
Dim lngIndex As Long
Dim lngView As Long
lngView = ActiveDocument.ActiveWindow.View
For Each oStory In ActiveDocument.StoryRanges
For lngIndex = oStory.ShapeRange.Count To 1 Step -1
Set oShape = oStory.ShapeRange.Item(lngIndex)
oShape.Anchor.Select
If MsgBox("Delete the selected shape?", vbYesNo) = vbYes Then
oShape.Delete
End If
Next lngIndex
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
For lngIndex = oStory.ShapeRange.Count To 1 Step -1
Set oShape = oStory.ShapeRange.Item(lngIndex)
oShape.Anchor.Select
If MsgBox("Delete the selected shape?", vbYesNo) = vbYes Then
oShape.Delete
End If
Next lngIndex
Wend
End If
Next oStory
lbl_Exit:
Set oShape = Nothing
Set oStory = Nothing
ActiveDocument.ActiveWindow.View = lngView
Exit Sub
End Sub

[mikewi]

Works amazing thanks guys.

[gmayor]

Graham,
This should keep if from losing track:
Of course it should. I don't know where my head is this morning :(

[mikewi]

Hey guys this is functioning correctly by asking for each object before deleting. The one issue I'm noticing is that I can't actually see the object so I can make a decision if I want it gone or not. Any Ideas??