Code to Replace Logo

[megha]

I am using the following code to replace the logo located in the header in all the documents in a folder. it's working fine except one thing. It does not delete the old logo. can someone please help?
[VBA]
Sub ReplaceJustLogo()
Dim wrd As Word.Application
Set wrd = CreateObject("word.application")
wrd.Visible = True
AppActivate wrd.Name
'Change the directory to YOUR folder's path
fName = Dir("C:\temp\*.doc")
Do While (fName <> "")
With wrd
'Change the directory to YOUR folder's path
.Documents.Open ("C:\Temp\" & fName)
If .ActiveWindow.View.SplitSpecial = wdPaneNone Then
.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
.ActiveWindow.View.Type = wdPrintView
End If
.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
.Selection.WholeStory
If .Selection.InlineShapes.Count <> 0 Then .Selection.InlineShapes(1).Delete
.Selection.Paste
.ActiveDocument.Save
.ActiveDocument.Close
End With
fName = Dir
Loop
Set wd = Nothing
End Sub

[/VBA]

[fumei]

Is the old logo the only thing in the header?

I take it you are selecting the new logo BEFORE you start this code. Does this actually work?

[MacroShadow]

Is your logo an InlineShape?

[megha]

Hello Fumei - Thanks for your reply. My header has logo and some text too but logo is the only graphic i have in the header. Yes, i am copying the new logo to the clipboard before starting this code. It's working but like i have said it is not taking off my old logo.

Hello MacroShadow - Thanks for your reply. Some files has inlineshape and some are top of the text.

[Paul_Hossler]

Can you post a small sample document?

Paul

[MacroShadow]

Some files has inlineshape and some are top of the text.

And the macro from the kb doesn't delete the inlineshapes either?

[megha]

Attached is the sample document with the header. Any help would be
appreciated.

[fumei]

Ummm, you have TWO Shapes (not InlineShapes) grouped together.

So. Where are you copying the new logo from? Does it also have two Shapes? How are you putting it into the correct location? Is the Paste doing that?

To delete the old logo (TWO Shapes), you need to delete both of them.[vba]
Sub DeleteShapes()
ActiveDocument.Sections(1).Headers(1).Shapes(1).Delete
' which deletes Shapes(1)...which makes Shapes(2)
' into Shapes(1),so delete (1) again
ActiveDocument.Sections(1).Headers(1).Shapes(1).Delete
End Sub[/vba]

If the code you posted is acceptable (and it COULD be done better), simply add a Call to a procedure to delete the Shapes. IF you are pasting in the new logo as a Shape, delete the old ones FIRST.[vba]
Do While (fName <> "")
With wrd
'Change the directory to YOUR folder's path
.Documents.Open ("C:\Temp\" & fName)
Call DeleteShapes
If .ActiveWindow.View.SplitSpecial = wdPaneNone Then
.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
.ActiveWindow.View.Type = wdPrintView
End If
.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
.Selection.WholeStory
If .Selection.InlineShapes.Count <> 0 Then .Selection.InlineShapes(1).Delete
.Selection.Paste
.ActiveDocument.Save
.ActiveDocument.Close
End With
.......[/vba]

[megha]

Thank you fumei. I tried your suggestions but didn't work. I am getting error message. It says "Run time error 217024809, The index into the specified collection is out of bounds."

BTW what's the best way to modify the code because i just realized that some of my documents have two shapes grouped together, some have two ungrouped shapes, some have one shape and just one line regular text underneath the shape. I have attached the sample headers.

[megha]

any suggestions???

[Frosty]

Here's a suggestion.

Try the following code on any of your various document types, and report if it is successful deleting all of your shapes of various types. There are a number of possibilities of why things might not be working... too many to post.

If it is successful deleting the shapes you want deleted, then simply call it at the top of your macro before you run the code that inserts the shape you want. If it is not successful, then post a document it is not successful on.

Good luck!
[vba]
Public Sub DeleteAllShapesInAllHeaders()
Dim hf As HeaderFooter
Dim oSec As Section
Dim i As Integer

For Each oSec In ActiveDocument.Sections
For Each hf In oSec.Headers
'delete all shapes
For i = hf.Shapes.Count To 1 Step -1
hf.Shapes(i).Delete
Next
'delete all inline shapes
For i = hf.Range.InlineShapes.Count To 1 Step -1
hf.Range.InlineShapes(i).Delete
Next
Next
Next

End Sub
[/vba]

[BoatwrenchV8]

Hmmm. Looks like you are working it backwards and deleting the shapes from the last to the first. Have read that is the proper way of doing this with shapes, bookmarks, comments, etc. Thanks Frosty, I need to steal this one as I am sure I will be using this in the future.

[Frosty]

It's the way to work with any collection, if you are altering the number in the collection. For each... Loops are prettier, but you can't iterate through a collection and delete elements.

The only other way to do it is a static loop (for i=1 to 5) and then use an on error resume next as you continually delete the first item in the collection (I suspect fumei's code would have worked if he added on error resume next). But it would have only deleted a maximum of 2 shapes, and it seems as if the OP is trying to handle multiple scenarios (inline shapes, shapes, grouped objects, etc)

[fumei]

Yes, and we did not know there WAS a multitude of scenarios, which if you look at indicates a hodge-podge of situations.