shapes count in a section

[glencoe]

I am trying to figure out how to process properly the Shapes (textboxes) that I have in a given section...
What I want to achieve in the code below is to go into each Shape (textbox) of each header* within the same section and process it (highlight tags).
What actually happens is that the code will not stop there and will process all shapes (even in the footer) before going to the next header and section.
What am I doing wrong here? It looks like I don't "limit" the execution to the textbox I am working on...

* I know (from another post) that textboxes within headers is an abomination for some of you. I don't want to argue again about it, it only is a fact that I have documents (i.e. converted from PDF) which do have textboxes in headers... :(



Dim oSection as Range
Dim oHF as Range
Dim Shp as Shape
Dim oOpenTag as Range
Dim oExtraTag as Range

strOTag="##"
For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Headers
With oHF
If .LinkToPrevious = False Or oSection.Index = 1 Then 'Header not linked to the previous one
For Each Shp In oHF.Shapes 'Pour chaque boîte trouvée
If Shp.TextFrame.HasText Then the Shape is a textbox
Set oOpenTag = Shp.TextFrame.TextRange 'Whole box
Set oExtraTag = oOpenTag.Duplicate 'Duplicating oTextRng
While InStr(oExtraTag.Text, strOTag) > 0 'Extra opening tag found in oExtraTag. Highlighting tags
With oExtraTag.Find
.Text = strOTag 'opening tag
If .Execute Then 'Find opening tag. oExtraTag is therefore the extra opening tag
oExtraTag.HighlightColorIndex = wdRed 'Highlight opening tag
Set oOpenTag = Shp.TextFrame.TextRange 'Whole box
oOpenTag.Start = oExtraTag.End 'Starting position of oTextRng is now the end of Opening tag
Set oExtraTag = oOpenTag.Duplicate 'Duplicating oTextRng
End If
End With
Wend
End If
Next Shp
End If
End With
Next oHF
Next oSection

[gmaxey]

glencoe,

You are about to discover the "ShapeRange"


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
MsgBox oHdrPri.Shapes.Count
MsgBox oHdrEven.Shapes.Count
'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, 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
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oSection As Section 'Range - How did "Range" compile in the code you posted?
Dim oHF As HeaderFooter 'Range - How did "Range" compile in the code you posted?
Dim Shp As Shape
Dim oOpenTag As Range
Dim oExtraTag As Range
Dim strOTag As String 'Not declared.
strOTag = "##"
For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Headers
With oHF
If .LinkToPrevious = False Or oSection.Index = 1 Then 'Header not linked to the previous one
For Each Shp In oHF.Range.ShapeRange 'There is a big difference between .Range.Shapes.Count and .ShapeRange
If Shp.Type = msoTextBox Then 'If Shp.TextFrame.HasText Then the Shape Is a textbox (***not always true)
Set oOpenTag = Shp.TextFrame.TextRange 'Whole box
Set oExtraTag = oOpenTag.Duplicate 'Duplicating oTextRng
While InStr(oExtraTag.Text, strOTag) > 0 'Extra opening tag found in oExtraTag. Highlighting tags
With oExtraTag.Find
.Text = strOTag 'opening tag
If .Execute Then 'Find opening tag. oExtraTag is therefore the extra opening tag
oExtraTag.HighlightColorIndex = wdRed 'Highlight opening tag
Set oOpenTag = Shp.TextFrame.TextRange 'Whole box
oOpenTag.Start = oExtraTag.End 'Starting position of oTextRng is now the end of Opening tag
Set oExtraTag = oOpenTag.Duplicate 'Duplicating oTextRng
End If
End With
Wend
End If
Next Shp
End If
End With
Next oHF
Next oSection
lbl_Exit:
Exit Sub
End Sub

[glencoe]

argh, I was so close from finding it! I had actually seen the ShapeRange, but I had not figured out how to use it in my code... I feel like I just lost the gold medal at the Olympics.

As for your comment "If Shp.TextFrame.HasText Then the Shape Is a textbox (***not always true)", I know indeed that there is another point to consider, i.e. if the box is only a shape that contains other textboxes... Don't ask. Yes, I also have messy documents with those (converted from some weird format. The layout is a nightmare). For those, I am playing with the line "If Shp.CanvasItems.Item(j).Type = msoTextBox Then"... I am not there yet in my code.

Thanks gmaxey, I will check your code a bit later, but from what I can tell, you got exactly what I need! I also hope you're glad I didn't have any "Selection" in my code! :p

[gmaxey]

I'm simply in raptures! Glad I could help.

[glencoe]

Greg, I have a few questions:

1) Based on the loop you suggested, I see the line


if Shp.Type = msoTextBox Then

but I wonder if the following line would do the same, or means something else:


If Shp.TextFrame.HasText Then

If they don't do the same, I could use both within the same test...


2) Also, with using the line


For Each Shp In oHF.Range.ShapeRange

if one shape is not a text box, but contains other text boxes, would it required to add code to go into this shape and within each text box inside, or would the main loop do the job by itself?
I was using the following lines when I was working with Selections, and the code seemed to work:



If Shp.TextFrame.HasText Then
'blabla
Else
For j = 1 To Shp.CanvasItems.Count
If Shp.CanvasItems.Item(j).Type = msoTextBox Then


Should I use it again or not?


3) With the part that processes the headers in general, I noticed some weird behaviour using the code


For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Headers
With oHF
If .LinkToPrevious = False Or oSection.Index = 1 Then
''blablabla

Sometimes, one range is empty, so the code is going in the "blabla" section for nothing. So I thought I could test the range using


If oHF.Range <> "" then

but even though the range is empty, this test would fail. I then noticed that the range actually has one space, so I changed the test to


If oHF.Range <> " " then

same issue again. I then thought this would work:


If oHF.Range.Text <> "" And oHF.Range <> " " then

Naaaa... This one?



If len(oHF.Range) >1 then

but halas...
That's when I thought of using a string:


strHeaderText = oHF.Range
If Len(strHeaderText) > 1 Then


And this test works and gives me the expected result.
Now, why did the other tests fail, though their results were actually meeting the test conditions?

[macropod]

Using 'If Shp.Type = msoTextBox Then ' is not the same as using 'If Shp.TextFrame.HasText Then' for the simple reason that shapes other than textboxes can have text. A simple example is WordArt.

As for the HdFt content testing, you could use 'If len(Trim(oHF.Range.Text)) >1 Then'.

[glencoe]

Thanks macropod!
Regarding my first question, I will them use both tests in the same loop, to avoid missing some cases.
As for your test, it is indeed another option, but I actually wondered why all the tests I tried failed to trigger the if loop, even though their conditions were met. What did I do wrong in those tests? I assume this is my mistake, and not a bug. I guess that there is something I did not understand why Ranges yet, but what is it? That's my question!

[macropod]

I actually wondered why all the tests I tried failed to trigger the if loop, even though their conditions were met.
Well, their conditions probably were not met, actually. Consider 'If oHF.Range <> " " Then' and 'If oHF.Range.Text <> "" And oHF.Range <> " " Then'. These both ignore the paragraph break that's part of the range's text, so the test will always fail. As for 'If len(oHF.Range) >1 Then', the range length is a minimum of one character (the paragraph break) so any content other than a shape will cause it to return 'True' - but it fails to test shaperanges, whose anchors have no length.

[glencoe]

Your explanation is certainly very useful to know! Thanks macropod!

I still need some hint on my question 2:

Is there any use to code this:


If Shp.TextFrame.HasText Or Shp.Type = msoTextBox Then
'blabla
Else
For j = 1 To Shp.CanvasItems.Count
If Shp.CanvasItems.Item(j).Type = msoTextBox Then
'blablabla

[macropod]

Since you're already testing each shape, I don't see any benefit of going through grouped shapes separately. Besides, do you have any reason to believe some shapes have been grouped?

[glencoe]

Well, let me ask the question the other way: if I only keep the first part (If Shp.TextFrame.HasText Or Shp.Type = msoTextBox Then), would it also work in grouped shapes? Indeed, shapes may happen to be grouped, I have no control on this. So I need to make sure the loop is processing them as well. If you tell me that the code below is enough to cover all cases, I don't need to do anything else...


For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Headers
With oHF
If .LinkToPrevious = False Or oSection.Index = 1 Then 'Header not linked to the previous one
For Each Shp In oHF.Range.ShapeRange 'There is a big difference between .Range.Shapes.Count and .ShapeRange
If Shp.Type = msoTextBox Or Shp.TextFrame.HasText Then

[macropod]

In that case, you would need something like:

Dim i As Long, j As Long
With ActiveDocument
For i = .Shapes.Count To 1 Step -1
With .Shapes(i)
If .TextFrame.HasText Then
MsgBox .TextFrame.TextRange.Text
ElseIf .Type = msoGroup Then
For j = .GroupItems.Count To 1 Step -1
If .GroupItems(j).TextFrame.HasText Then
MsgBox .TextFrame.TextRange.Text
End If
Next
End If
End With
Next
End With
Note: I've run the loops backwards and used indices to allow for the possibility that one might want to extract the content then delete the shapes.

[glencoe]

yeah, that's a clever way to do it! Thanks macropod! :-)