Delete header/footer text from pages with shapes

[ceilidh]

Hello again,

I hope this is an easier question for you all!

I have a Word doc where some pages have text on them and some pages have graphs. On the pages which have graphs, the graph has been inserted into the page - they are objects/pictures/shapes, rather than text.

I have headers and footers on every page of the doc. I want to delete the text from the headers/footers on the pages which have graphs, while leaving them on the pages which have text. I thought I could do this by telling Word to look at each page for a shape, and if there's a shape then delete the header/footer text. But my code isn't working. Here it is:

Sub Delete_HeadersAndFooters_From_Graphs()

Dim i As Long

For i = 1 To ActiveDocument.InlineShapes.Count
With ActiveDocument.InlineShapes(i)
.Headers(wdHeaderFooterPrimary).Range.Text = ""
.Footers(wdHeaderFooterPrimary).Range.Text = ""
End With
Next

End Sub

I hope I got the VBA tags correct this time....

When I run this code I get an error "Compile error: Method or Data member not found" and it's on the line that starts ".Headers..."

What am I doing wrong this time? Is this another thing that looks easy but really is not...?

[gmaxey]

ceilidh,

This order may be taller than your last. A Word document, before it is printed on the page or the screen by a print driver, really does have pages. So the first big problem is there is no ready made way to say does this page (that doesn't exist) contain text or a shape.

Even if you could then you face the other problem that headers and footers are not determined by pages (which don't exist) but by sections which do. Each new Word document has 1 section. Each section contains (whether you use them or not) 3 headers (first, even, primary) and 3 footers (first, even, primary). If you get this, and I'm sure you do, then you will see that you would have to have your document divided up into two or more sections. One or more that contain text, and one or more that contains graphics.

Manually, you will need to insert section breaks betwen the end of each text section and the beginning of a graphic. Then in the new section header in hte graphic section you will need to unlink the header and delete the header.

You might be able to employ the Pages and Rectangles objects of the ActivePane, but determining which rectangle to use could be next to impossible. In the example below, I started with three pages. Each page had a header. Page 2 had a single inlineshape. Since there is header text defined on each page the rectangle to use is 2. This code inserted the required section break and removed the header text from the next section 2. However, the header on the following text page is also removed.

I just don't know if this is possible.



Sub APoorAttempt()
Dim i As Long
Dim oPage As Page
Dim oRng As Word.Range
Dim oSec As Section
For Each oPage In ActiveDocument.ActiveWindow.ActivePane.Pages
Debug.Print oPage.Rectangles(2).Range.InlineShapes.Count
If oPage.Rectangles(2).Range.InlineShapes.Count > 0 Then
Set oRng = oPage.Rectangles(2).Range.Duplicate
oRng.Collapse wdCollapseStart
oRng.Move wdParagraph, -1
oRng.Select
oRng.InsertBreak (wdSectionBreakNextPage)
i = Selection.Sections(1).Index
Set oSec = ActiveDocument.Sections(i + 1)
With oSec.Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Text = ""
End With
End If
Next oPage
lbl_Exit:
Exit Sub
End Sub

[ceilidh]

I'm sorry... :eek:

I already have section breaks in this doc between the pages with text and the pages with graphs, so I don't need to insert those. That may cut things down a bit...

What's happening is, I have a bunch of individual docs. Some are "ordinary" word docs with headers and footers. And some are single page docs with just a graphic inserted and have no header and footer. These docs all get stuck together with a section break between each doc, to make one big compiled doc containing many sections. Where the graphics pages are in their own sections, interleaved with the other "ordinary" pages which are also in their own sections... ugh, I don't think I'm describing this well at all.

I have a macro that sticks these individual docs together. Works very well, except that the headers and footers get carried over from the "ordinary" docs onto the "graphics" docs. (Even though I do specify LinkToPrevious = False, and I checked and all headers/footers do have LinkToPrevious set to False.)

So, I end up manually deleting headers/footers from the "graphics" pages. Because I was able to reset LinkToPrevious = False throughout, at least I can delete the header/footer from one graph (which is in one section) without it's affecting any of the other sections. I just get very tired of manually deleting the headers/footers. So....... that's why I wondered about automating that.

[gmaxey]

In that case you might try this cobbled up mess:

Sub ScratchMacro()
'A quick macro scratch pad created by Greg Maxey
Dim oSec As Section
Dim i As Long
For Each oSec In ActiveDocument.Sections
With oSec
For i = 1 To 3
With oSec.Headers(i)
.LinkToPrevious = False
End With
Next i
End With
Next oSec
For Each oSec In ActiveDocument.Sections
With oSec
For i = 1 To 3
With oSec.Headers(i)
If oSec.Range.InlineShapes.Count > 0 Then
.Range.Text = ""
End If
End With
Next i
End With
Next oSec
End Sub

[ceilidh]

It works for the headers! Not the footers, those are still there. But I just ran it on a doc with a few interleaved graphs, and the headers are all gone from the graphs pages while still being left intact on the "ordinary" pages. Great!

Can I just duplicate the text for headers to deal with footers also? Or do I need different code for footers?

[gmaxey]

I didn't test this but I think it will work:

Sub ScratchMacro()
'A quick macro scratch pad created by Greg Maxey
Dim oSec As Section
Dim i As Long
For Each oSec In ActiveDocument.Sections
With oSec
For i = 1 To 3
With oSec.Headers(i)
.LinkToPrevious = False
End With
With oSec.Footers(i)
.LinkToPrevious = False
End With
Next i
End With
Next oSec
For Each oSec In ActiveDocument.Sections
With oSec
If .Range.InlineShapes.Count > 0 Then
For i = 1 To 3
With oSec.Headers(i)
.Range.Text = ""
End With
With oSec.Footers(i)
.Range.Text = ""
End With
Next i
End If
End With
Next oSec
End Sub

[Frosty]

You could probably do it in a single pass if you went backwards... but this is just a flavor thing. The only important concept here, for the purposes of learning, is that it is sometimes useful to cycle through things backwards. So I'm demoing that, but this is not appreciably functionally different than Greg's code.


Public Sub ClearHeadersAndFootersFromSectionsWithGraphics()
Dim i As Integer
Dim x As Integer

'go through each section, backwards
For i = ActiveDocument.Sections.Count To 1 Step -1
'in each section
With ActiveDocument.Sections(i)
'cycle through each headerfooter type
For x = 1 To 3
'turn off same as previous no matter what
.Headers(x).LinkToPrevious = False
.Footers(x).LinkToPrevious = False
'check for any inline shapes in this section, and if so
If .Range.InlineShapes.Count > 0 Then
'wipe out the header and the footer
.Headers(x).Range.text = " "
.Footers(x).Range.text = " "
End If
Next
End With
Next
End Sub

EDIT: whoops, used "i" when I meant "x"

[ceilidh]

Thanks... I've just tried both sets of code. Both work beautifully on the headers.

But, they don't work on the footers, which I think is because the footers contain tables - I recognise the error message about the "range cannot b deleted". And when I put in Table(x).Cell(x, y) I get another message "requested member of the collection does not exist".

What I don't understand, though, is that the headers also contain tables - all of them - and yet the code works on the headers. Why would code break because of a table in the footer and yet the same code doesn't care about tables in the headers? (The tables in the headers also have columns - the first row has 3 columns on some pages for example.)

Is there any VBA instruction that would delete the footer regardless of whatever is in it or it's composition?

My problem is that the footnotes can vary a little - some footnotes have 1 row split into two columns as their first footer, and some have 1 row that is one big column as their first footer. So, sometimes, saying "Table(1).Cell(1, 2) would work and other times it wouldn't. At the moment I'm wondering if there's any way to say .Table(all).Cell(all).... ?

[Frosty]

Did you mean to mix up footnotes and footers?
I think you need to post a sample document (removing anything sensitive).

It's something specific about you document construction

[ceilidh]

Here's a demo doc with all info removed. 3 sections, 8 pages. Note the footer field on the last page (last section) compared to the footer fields in the previous 2 sections. This is why, when I do Table(x).Cell(x, y) I keep getting messages saying that the range doesn't exist or can't be deleted... because footers that I can delete on that last page don't exist on the preceding pages.

Still don't understand why, if we can delete the header field (which is a table as you can see in the demo doc) in it's entirety, we cannot do the same for the footer field.

I hope the attachment of the file succeeded!

[Frosty]

it's not a good answer, but it has to do with the way the document was constructed. It's set up in a way that is corrupt. Normally, the last character of any "story range" (meaning, the main document, a footer, a header, a footnote, etc etc), is supposed to be a paragraph mark.

In the headers, this is true. In the footers, your last character is an end of row table character. That's not supposed to happen. And, in fact, I don't think it's possible in the normal end-user interaction. But code can do funny things.

So I think you need to have two steps to "delete" your footer text.
.Footers(x).Range.Tables(1).Delete
.Footers(x).Range.Text = " "

Of course, you might need further modifications, if this sample document isn't representative of all the other types of footers, but I think it shouldn't be to tough.

One thing to note... you *could* try
.Footers(x).Range.Delete
But then you'll see an error regarding corrupt tables.

I'm not sure if this is a corruption you need to worry about or not, but something about your creation process is performing a "no no" operation :)

[ceilidh]

This sample doc is representative I'm afraid. But your explanation about the paragraph marking was very helpful - I didn't know that before. So, I just went and looked at the original docs (which I'm chaining up together into one big doc) to see if they had a paragraph mark at the end of the footer. Thought maybe I was deleting that when I chained up the docs. But no, none of the original docs have a paragraph mark at the end of the footer. So, it's not my code which chains them up into one big doc that is affecting that.

So then I thought maybe I could insert a paragraph mark as I chained them up. But that's not working... of course! Here's the bit of code where I tried... the red text shows the bit I inserted to try make a paragrah break. No good. (The non-red highlighted code does work.)

(Which brings me back to the original code "ClearHeadersAndFooters..." to wipe the footer fields. I just tried your edits, and they don't work - I get the same error message, "range cannot be deleted".... :( )


Selection.InsertFile FileName:=strPath & strTextLine, _

Range:="", ConfirmConversions:=False, _

Link:=False, Attachment:=False



'Turn off link to previous footer.

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

If Selection.HeaderFooter.LinkToPrevious = True Then

Selection.HeaderFooter.LinkToPrevious = False

Selection.EndKey Unit:=wdStory

Selection.InsertParagraphAfter

End If

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

[Frosty]

This code doesn't work on your document? It worked on the attachment you gave...

Public Sub ClearHeadersAndFootersFromSectionsWithGraphics()
Dim i As Integer
Dim x As Integer

'go through each section, backwards
For i = ActiveDocument.Sections.Count To 1 Step -1
'in each section
With ActiveDocument.Sections(i)
'cycle through each headerfooter type
For x = 1 To 3
'turn off same as previous no matter what
.Headers(x).LinkToPrevious = False
.Footers(x).LinkToPrevious = False
'check for any inline shapes in this section, and if so
If .Range.InlineShapes.Count > 0 Then
'wipe out the header and the footer
.Headers(x).Range.text = " "
.Footers(x).Tables(1).Delete
.Footers(x).Range.text = " "
End If
Next
End With
Next
End Sub

[ceilidh]

When I ran it on the combined doc I have, it worked on the first graph. Didn't work on the second one and I got the error message then. Sorry...

Do you want me to post a bigger doc with >1 graph page in it?

[Frosty]

Try this...

Public Sub ClearHeadersAndFootersFromSectionsWithGraphics()
Dim i As Integer
Dim x As Integer

'go through each section, backwards
For i = ActiveDocument.Sections.Count To 1 Step -1
'in each section
With ActiveDocument.Sections(i)
'cycle through each headerfooter type
For x = 1 To 3
'turn off same as previous no matter what
.Headers(x).LinkToPrevious = False
.Footers(x).LinkToPrevious = False
'check for any inline shapes in this section, and if so
'If .Range.InlineShapes.Count > 0 Then
'wipe out the header and the footer
.Headers(x).Range.text = " "
While .Footers(x).Range.Tables.Count > 0
.Footers(x).Range.Tables(1).Delete
Wend
.Footers(x).Range.text = " "
'End If
Next
End With
Next
End Sub

[ceilidh]

Okay, tried it. It runs error-free, but it wipes all of the headers and footers on every page, and not just the pages with graphs.... did you intend that though, since I noticed you remmed out the InlineShapes line?

[Frosty]

No, sorry... uncomment those lines. That was my test code, since you I didn't have any inline shapes in the demo.docx.

[Frosty]

Just a quick explanation of why it had an error. Since the code cycles through *all* header and footer objects (even the one or two you're not showing- even header/footers and first page header/footers), you probably didn't have any tables in those areas.

[ceilidh]

No, sorry... uncomment those lines. That was my test code, since you I didn't have any inline shapes in the demo.docx.

Uncommented them... it works!!! All the graphs have their headers/footers wiped, not just the first graph. And no error messages. Thanks!

Edited to add, thanks for the explanations too. It helps me a lot, to know why this is happening.