Replace-Image-in-Document-Header

[theHydra]

I hope someone is still watching this thread.

This script is exactly what I need but I'm having problems getting it to make changes. It runs and I see the files being opened but it doesn't replace the file. it actually did work on one, but not others, so I suspect there is something with the header.

Any help is GREATLY needed and appreciated.

Here's the code if it matters:



Sub Pic()
Dim strFile As String
Dim oRng As Range
Const strPath As String = "C:\Users\Joshua\OneDrive\Desktop\EHS 4\" '"C:\PMRHeader\PMR\"
Const strNewImage As String = "C:\Users\Joshua\Pictures\PDI.png" '"C:\PMRHeader\Repso1.jpg"

strFile = Dir$(strPath & "*.doc*")
Do While strFile <> ""
Application.Documents.Open strPath & strFile
If ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Count = 2 Then
Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(2).Anchor
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(2).Delete
oRng.InlineShapes.AddPicture strNewImage
If ActiveDocument.Saved = False Then ActiveDocument.Save
End If
ActiveDocument.Close
strFile = Dir$
Loop
lbl_Exit:
Exit Sub
End Sub

[SamT]

Moved From http://www.vbaexpress.com/forum/showthread.php?56773

[macropod]

The macro you've posted is for processing floating shapes; it won't work with inlineshapes. What shape format(s) are you working with?