shapes count in a section

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... :(

Code:

---

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

---

glencoe,

You are about to discover the "ShapeRange"

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
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

---

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

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

Greg, I have a few questions:

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

Code:

---

if Shp.Type = msoTextBox Then

---

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

Code:

---

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

Code:

---

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:

Code:

---

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

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

Code:

---

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

Code:

---

If oHF.Range <> " " then

---

same issue again. I then thought this would work:

Code:

---

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

---

Naaaa... This one?

Code:

---

If len(oHF.Range) >1 then

---

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

Code:

---

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?

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'.

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!

Quote:

---

Originally Posted by glencoe

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.

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:

Code:

---

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

---

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?

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...

Code:

---

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

---

In that case, you would need something like:

Code:

---

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.

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