Different results from counts ... why?

[Robin]

I may be getting my objects mixed up here, but this is the situation. I have
a document that has three sections. Each section has a different header and
footer with a different number linked images and other shapes in it. The
heading and footer used in an entire section is the same - no variations for
first page or numbered pages in that section.

When I count the number of shapes in each header/footer using the Count
property on the Shapes object, it tells me there are 16 shapes in each. This
is not correct, it is 16 for the entire document, so why is it not specific
for each section?

The code I have is as follows:



SubSub CleanHeader()

Dim s As Section
Dim j As Shape
Dim myRange As Range
Dim i As Integer
Dim n As Integer

' First we did a straight count on each section - they all gave 16 which is
wrong

MsgBox ("total 1: " &
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.Count)
MsgBox ("total 2: " &
ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary).Shapes.Count)
MsgBox ("total 3: " &
ActiveDocument.Sections(3).Headers(wdHeaderFooterPrimary).Shapes.Count)

' Then we did a systematic count - they also gave 16 which is wrong

For Each s In ActiveDocument.Sections
n = 0
For Each j In s.Headers(wdHeaderFooterPrimary).Shapes
n = n + 1
Next j
MsgBox ("total: " & n)
Next s

End Sub
Any help appreciated.

thanks
Robin

 

[macropod]

Hi Robin,

That's because, when the headers are linked, the shapes exist in each header. Try:
Sub CleanHeader()
Dim rngScn As Section
Dim Shp As Shape
Dim i As Integer
For Each rngScn In ActiveDocument.Sections
i = 0
With rngScn.Headers(wdHeaderFooterPrimary)
If .LinkToPrevious = False Then i = .Shapes.Count
MsgBox "Section " & rngScn.Index & " primary header shapes total = " & i
End With
Next
End Sub

 

[Robin]

Hi Macropod,

I have tried what you suggested, but the counts are still the same across
all sections.

I then manually linked all sections in the document and could see the
document displaying "Same as previous" in the header. The shapes in section 2
and 3 disappeared and the macro displayed the first as having 13, the second
0 and the third 0. Really wierd?

thanks
Robin

 

[macropod]

Hi Robin,

Try:
Sub CleanHeader()
Dim rngScn As Section, i As Integer
For Each rngScn In ActiveDocument.Sections
i = 0
With rngScn.Headers(wdHeaderFooterPrimary)
If .LinkToPrevious = False Then i = .Range.ShapeRange.Count
MsgBox "Section " & rngScn.Index & " primary header shapes total = " & i
End With
Next
End Sub

 

[Robin]

Hi Macropod,

No it's not working. I'm getting results of 0, 2 and 2 for the sections 1, 2
and 3 respectively and I know it should be 7, 3,10

The heading/footer content for each section are:
The first section with 7 consists of 6 linked images and 1 unlinked image.
The second has a linked image (applied via a quick list heading definition)
a line below the heading and a line above the footer (Word drawing elements).
The third section has eight text boxes and 2 linked images.

thanks
Robin

 

[macropod]

Hi Robin,

Do any of the Sections have different first page or odd/even page setups? This matters because the code tests only the primary
header.

Are you sure none of the images etc is formatted as in-line with text? This matters because InlineShapes are treated differrently
from other Shapes (eg 'square'), which is what the macro is trying to count. A quick & dirty change to the code to include
InlineShapes is to change:
i = .Range.ShapeRange.Count
to:
i = .Range.ShapeRange.Count + .Range.InlineShapes.Count

For something more comprehensive, accounting for all headers, try:
Sub CleanHeader()
Dim rngScn As Section, i As Integer, oHead As HeaderFooter
For Each rngScn In ActiveDocument.Sections
i = 0
For Each oHead In rngScn.Headers
With oHead
If .LinkToPrevious = False Then i = i + .Range.ShapeRange.Count + .Range.InlineShapes.Count
End With
Next
MsgBox "Section " & rngScn.Index & " header Shapes & InlineShapes total = " & i
Next
End Sub

 

[Greg Maxey]

Robin,

All all or the shapes floating or are there any that are inline? Try
using .range.shaperange and adding a count of inlineshapes:

Sub CleanHeader()
Dim oDoc As Word.Document
Dim oSec As Section
Dim oShape As Shape
Dim oILS As InlineShape
Dim myRange As Range
Dim i As Integer
Dim n As Integer
Set oDoc = ActiveDocument
MsgBox "Total 1: " & oDoc.Sections(1).Headers
(1).Range.ShapeRange.Count + oDoc.Sections(1).Headers
(1).Range.InlineShapes.Count
MsgBox "Total 2: " & oDoc.Sections(2).Headers
(1).Range.ShapeRange.Count + oDoc.Sections(2).Headers
(1).Range.InlineShapes.Count
MsgBox "Total 3: " & oDoc.Sections(3).Headers
(1).Range.ShapeRange.Count + oDoc.Sections(3).Headers
(1).Range.InlineShapes.Count
For Each oSec In oDoc.Sections
n = 0
For Each oShape In oSec.Headers(1).Range.ShapeRange
n = n + 1
Next oShape
For Each oILS In oSec.Headers(1).Range.InlineShapes
n = n + 1
Next oILS
MsgBox ("total: " & n)
Next oSec
End Sub

Hi Robin,

Do any of the Sections have different first page or odd/even page setups?This matters because the code tests only the primary
header.

Are you sure none of the images etc is formatted as in-line with text? This matters because InlineShapes are treated differrently
from other Shapes (eg 'square'), which is what the macro is trying to count. A quick & dirty change to the code to include
InlineShapes is to change:
i = .Range.ShapeRange.Count
to:
i = .Range.ShapeRange.Count + .Range.InlineShapes.Count

For something more comprehensive, accounting for all headers, try:
Sub CleanHeader()
Dim rngScn As Section, i As Integer, oHead As HeaderFooter
For Each rngScn In ActiveDocument.Sections
  i = 0
  For Each oHead In rngScn.Headers
    With oHead
      If .LinkToPrevious = False Then i = i + .Range.ShapeRange..Count + .Range.InlineShapes.Count
    End With
  Next
  MsgBox "Section " & rngScn.Index & " header Shapes & InlineShapes total = " & i
Next
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

Hi Macropod,

No it's not working. I'm getting results of 0, 2 and 2 for the sections1, 2
and 3 respectively and I know it should be 7, 3,10

The heading/footer content for each section are:
The first section with 7 consists of 6 linked images and 1 unlinked image.
The second has a linked image (applied via a quick list heading definition)
a line below the heading and a line above the footer (Word drawing elements).
The third section has eight text boxes and 2 linked images.

thanks
Robin- Hide quoted text -

- Show quoted text -

 

[Greg Maxey]

Paul,

Sorry. I see now that you had already suggested using shaperange.

 

[Greg Maxey]

Robin,

I can't say that I understand the mechanics of it all, but I ran into a
similiar confusing issue with headers and shapes a while back. The
following demo may help illustrate why you are getting a count of 16 using
the shape collection with your original code:


Sub Demonstration()
Dim oShape As Word.Shape
Dim oHdrPri As HeaderFooter
Dim oHdrEven As HeaderFooter
Set oHdrPri = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
Set oHdrEven = ActiveDocument.Sections(1).Headers(wdHeaderFooterEvenPages)
'Confirm there are no shapes in the shapes collection of either header
MsgBox oHdrPri.Shapes.Count
MsgBox oHdrEven.Shapes.Count
'Specifically add a shape to the primary header
Set oShape = oHdrPri.Shapes.AddShape(6, 3, 3, 15, 15)
oShape.Name = "Octagon"
'A shape is physically there (visible in the document) and included in the
collection
MsgBox oHdrPri.Shapes.Count
'Now notice that while there is no apparent shape in the even page header,
the shape is still included in the collection
MsgBox oHdrEven.Shapes.Count
'Since the shape is in the collection you can act on it.
oHdrEven.Shapes("Octagon").Delete
'Put it back
ActiveDocument.Undo
'Since the shape is "not" physically there. It is not in the ShapeRange
On Error Resume Next
oHdrEven.Range.ShapeRange("Octagon").Delete
If Err.Number <> 0 Then
MsgBox Err.Description
End If
'Since it "is" in the oHdrPri ShapeRange then either works:
oHdrEven.Range.ShapeRange("Octagon").Delete
ActiveDocument.Undo
oHdrPri.Shapes("Octagon").Delete
End Sub

 

[Robin]

Hi Macropod and Greg -

OK, to answer some questions ... each section uses only one header definiton
so there are no differences as regards headers for first page in section, odd
pages in section or even pages in section.

Are the shapes inline? No, because they are all set so their Layout is
either behind or in front of text. None of them use "In line with text" as
their Layout setting.

This is what I found. First section has 5, second section has 2 and third
section has 3 - but this is limited to those in the headers of these sections
and not the section footers.

Header in section 1 has 5 not inlne images.
Header in section 2 has a graphic line and one image - both not inline.
Header in section 3 has an image and a text box - both not inline

So this sems to be counting correctly, it's not taking the footers into
account, so I enhanced it with this:

Sub CleanHeader1()
Dim rngScn As Section, i As Integer, j As Integer, oHead As HeaderFooter,
OFooter As HeaderFooter
For Each rngScn In ActiveDocument.Sections
i = 0
For Each oHead In rngScn.Headers
With oHead
If .LinkToPrevious = False Then i = i + .Range.ShapeRange.Count +
..Range.InlineShapes.Count
MsgBox "Header Shapes: " & .Range.ShapeRange.Count & "Inline: " &
..Range.InlineShapes.Count
End With
Next
MsgBox "Section Header " & rngScn.Index & " header Shapes & InlineShapes
total = " & i
Next

For Each rngScn In ActiveDocument.Sections
j = 0
For Each OFooter In rngScn.Footers
With OFooter
If .LinkToPrevious = False Then j = j + .Range.ShapeRange.Count +
..Range.InlineShapes.Count
MsgBox "Footer Shapes: " & .Range.ShapeRange.Count & "Inline: " &
..Range.InlineShapes.Count
End With
Next
MsgBox "Section Footer " & rngScn.Index & " header Shapes & InlineShapes
total = " & j

Next
End Sub

Now I have to digest the difference between ShapeRange and InlineShapes

Thanks again
Robin