Prepare yourself for eye strain
Originally Posted by Frosty
Prepare yourself for eye strain
So I glanced over it... I don't know that my structure is any better, technically, than yours. But, you could replace the ProcessStoryTypes, ProcessShape functions with my structure, maybe adjust my AddShapesRangesIn sub to be a bit more robust the way your ProcessShape works (to add ranges of canvasitem shapes, etc), and then you wouldn't have to have the SrchAndRplInStry function buried at multiple places... you'd just have a For Each loop of the StoryRanges_Real be an accurate collection of ranges to search through.
It doesn't really get around some of the other issues (although I notice my structure doesn't seem, at least in 2010, to leave the blank paragraph in there post-processing), but it's a somewhat more clear structure.
But it might just be re-arranging the deck-chairs... *shrug*
Oops, It didn't find text in shapes located in canvass items, but it does now:
[VBA]Option Explicit
'Proof of concept
Public Sub RealReplace()
Dim rngSearch As Range
For Each rngSearch In colStoryRanges_Real
With rngSearch.Find
.Text = "Test"
.Replacement.Text = "Test sat"
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
'The MS StoryRanges collection is fundamentally broken, this is an attempt to generate an accurate
'collection range of stories for the entire document
Public Function colStoryRanges_Real() As Collection
Dim colRet As Collection
Dim rngStory As Range
Dim hf As HeaderFooter
Dim oSec As Section
Set colRet = New Collection
'these are the easy ones
For Each rngStory In ActiveDocument.StoryRanges
Select Case rngStory.StoryType
Case wdCommentsStory, wdFootnotesStory, wdEndnotesStory
colRet.Add rngStory
Case wdMainTextStory
colRet.Add rngStory
'we also have shape ranges to deal with
AddShapeRangesIn rngStory, colRet
Case Else
'anything not on the above list, we need to add separately
End Select
Next
'Headers/Footers
For Each oSec In ActiveDocument.Sections
For Each hf In oSec.Headers
If hf.LinkToPrevious = False Then
colRet.Add hf.Range
'also add shape ranges
AddShapeRangesIn hf.Range, colRet
End If
Next
For Each hf In oSec.Footers
If hf.LinkToPrevious = False Then
colRet.Add hf.Range
'also add shape ranges
AddShapeRangesIn hf.Range, colRet
End If
Next
Next
Set colStoryRanges_Real = colRet
End Function
'Adds any shape ranges to the collection passed in
Public Sub AddShapeRangesIn(rngWhere As Range, Optional colRet As Collection)
Dim oShpIn As Shape
Dim oShape As Shape
On Error Resume Next
For Each oShape In rngWhere.ShapeRange
If oShape.TextFrame.HasText Then
colRet.Add oShape.TextFrame.TextRange
ElseIf oShape.Type = msoCanvas Then
For Each oShpIn In oShape.CanvasItems
If oShpIn.TextFrame.HasText Then
colRet.Add oShpIn.TextFrame.TextRange
End If
Next oShpIn
ElseIf oShape.Type = msoGroup Then
For Each oShpIn In oShape.GroupItems
If oShpIn.TextFrame.HasText Then
colRet.Add oShpIn.TextFrame.TextRange
End If
Next oShpIn
End If
Next
On Error GoTo 0
End Sub
[/VBA]
When I get a chance, I'll see if I can drop it in the add-in and make it work.
Thanks.
Yack!! Spoke too soon. It seems that Word 2010 can't deal with a For ... Each loop for processing the CanvassItems and GroupItems.
[VBA]Public Sub AddShapeRangesIn(rngWhere As Range, Optional colRet As Collection)
Dim oShpIn As Shape
Dim oShape As Shape
Dim i As Long
On Error Resume Next
For Each oShape In rngWhere.ShapeRange
If oShape.TextFrame.HasText Then
colRet.Add oShape.TextFrame.TextRange
ElseIf oShape.Type = msoCanvas Then
For i = 1 To oShape.CanvasItems.Count
'For Each oShpIn In oShape.CanvasItems
Set oShpIn = oShape.CanvasItems.Item(i) 'Added
If oShpIn.TextFrame.HasText Then
colRet.Add oShpIn.TextFrame.TextRange
End If
'Next oShpIn
Next i
ElseIf oShape.Type = msoGroup Then
For i = 1 To oShape.GroupItems.Count
'For Each oShpIn In oShape.GroupItems
Set oShpIn = oShape.GroupItems.Item(i) 'Added
If oShpIn.TextFrame.HasText Then
colRet.Add oShpIn.TextFrame.TextRange
End If
Next i
'Next oShpIn
End If
Next
On Error GoTo 0
End Sub
[/VBA]
I'll have to test and probably fix that in my published add-in :-(
After reading through all of this again, I think the answers to my original questions can be summed up by the following demonstration:
[VBA]Option Explicit
Sub SetUpExample()
Dim oDoc As Word.Document
Dim oRngStory As Word.Range
Dim lngJunk As Long
Set oDoc = Documents.Add
Stop
'Step through code and switch between code and document to follow the process.
Debug.Print oDoc.StoryRanges.Count
'A new document based on a clean normal template contains 1 storyrange. _
'If formatting marks are showing, the headers and footers will be empty (i.e., no visible paragraph mark.)
'This is because the header and footer ranges are not defined at this point.
oDoc.Sections.Add
Debug.Print oDoc.StoryRanges.Count
'Adding a section does no effect the storyrange collection. This step is used just for setup.
'Isolate section 2 header from section 1.
oDoc.Sections(2).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
'Reference a header.
oDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Text = "Section 2 Header text"
Debug.Print oDoc.StoryRanges.Count
'Simply referencing a header or footer defines and expands the storyrange collection to include the six header and footer storyranges.
For Each oRngStory In oDoc.StoryRanges
Debug.Print oRngStory.StoryType
Next oRngStory
'As Gerry stated, every range has at least one paragraph so defined, formally (empty) headers or footers will contain a paragraph mark.
'The following code similates a user clicking in the section one header (defined with a single paragraph and no text).
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
Debug.Print oDoc.StoryRanges.Count
'This action removes (kills) the six header and footer storyranges from the storyrange collection as the following illustrates!!
For Each oRngStory In oDoc.StoryRanges
Debug.Print oRngStory.StoryType
Next oRngStory
On Error GoTo Err_Handler
Err_ReEntry:
Set oRngStory = oDoc.StoryRanges(wdPrimaryHeaderStory)
Do Until oRngStory Is Nothing
Debug.Print oRngStory.Text
Set oRngStory = oRngStory.NextStoryRange
Loop
'Since we've reference the section 1 headers and created the range, we are left with empty paragraph marks. Remove them as demostrated above.
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
oDoc.Close wdDoNotSaveChanges
Exit Sub
Err_Handler:
'There is no wdPrimaryHeaderStory defined even though we can see the text in the section 2 header.
'As Jason has discovered, section 1 defines the 6 header/footer storyranges. To ensure they are defined all you need to do is reference them:
lngJunk = oDoc.Sections(1).Headers(1).Range.StoryType
Resume Err_ReEntry
End Sub
[/VBA]
I think one of the flaws in my earlier understanding was that lngJunk does "NOT" fix a skipped header/footer, rather is ensures the the 6 header/footer story ranges are in fact defined.
Jason and Gerry, thanks for your interest in this post and your comments.
I find headers/footers to be, and have been, one of the more fascinating part of the Word object model. I am still learning myself.
I don't know about you, Gerry... but if I already knew everything, I selfishly probably wouldn't participate in this forum. Learning new stuff (and helping others learn it) is the majority of the fun
Previous to this post, I didn't know how story ranges worked... and now I have a better understanding (for instance, I thought -- since I hadn't previously found the way to disapprove it-- that the header/footer paragraphs always existed, they just weren't shown).
I still find it strange that the footnote continuation and separator stories are created at the same time as the header/footer story ranges... and that those don't go away via the same process...
From talking to a few of the people at MS, I suspect that they simply forgot.I still find it strange that the footnote continuation and separator stories are created at the same time as the header/footer story ranges... and that those don't go away via the same process...
Agreed, learning IS the majority of the fun. Which is why, as you know, I try hard to encourage posters to actually learn and, at minimum, attempt to apply that in some demonstratable manner. They may get it wrong, but if there is sincere effort shown at trying to learn THAT makes me happy, and I am much much more willing to help further.
I do want to point out that Greg's statement "isolate" is in fact not quite accurate.
'Isolate section 2 header from section 1.
oDoc.Sections(2).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
Only Primary is "isolated". Only Primary is LinkToPrevious=False. FirstPage and OddEven of Section 2 are STILL Link(ed)ToPrevious to Section 1. You must explicitly unlink all six header/footer objects from the previous Section for a different Section to be truly "isolated".
I can not think of how many times I have had people get discombobulated by this.
Gerry,
True. I was referring to the visible headers of interest in the demo document. I typically use and advise:
[vba]Sub ScratchMacro()
Dim oSec As Section
Dim i As Long
For Each oSec In ActiveDocument.Sections
For i = 1 To 3
oSec.Headers(i).LinkToPrevious = False
oSec.Footers(i).LinkToPrevious = False
Next i
Next oSec
End Sub[/vba]
http://answers.microsoft.com/en-us/o...5-d5bb03328e74
Last edited by gmaxey; 05-23-2012 at 03:37 AM.
Oh I am aware that YOU would deal with it; I wanted to make sure anyone else reading this would (hopefully) understand that it may have to be dealt with.
Also as a comment that while it is possible to make the empty paragraphs become invisible again, and that apparently the storyrange is gone, IF there is content in nonvisible headerfooter objects (FirstPage or OddEven) - something that is exremely useful to do in some document structures - then in fact the storyrange is NOT gone.
Gerry,
That is true and to illustrate (plus attempt to clarify the header/footer isolation), I've modified the demo:
[VBA]Sub SetUpExampleII()
'This code demonstrates peculiarities in the Word "StoryRanges" collection and how to deal with them.
Dim oDoc As Word.Document
Dim oRngStory As Word.Range
Dim i As Long
Dim lngJunk As Long
Set oDoc = Documents.Add
Stop
'Step through code and switch between code and document to follow the process.
Debug.Print oDoc.StoryRanges.Count
'Notice that a new document based on a clean normal template contains only 1 storyrange.
'Depending on the version of Word there are a total of 11 to 17 storyRanges
'Ensure formatting marks are showing.
'Notice the headers and footers will be empty (i.e., no visible paragraph mark.)
'This is because the header and footer ranges are not defined at this point.
'Add a new section.
oDoc.Sections.Add
Debug.Print oDoc.StoryRanges.Count
'Notice that adding a section does no effect the storyrange collection.
'Isolate section 2 header and footers from section 1.
For i = 1 To 3
oDoc.Sections(2).Headers(i).LinkToPrevious = False
oDoc.Sections(2).Headers(i).LinkToPrevious = False
Next i
'Reference a header (do something with it, anything).
oDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Text = "Section 2 Header text"
Debug.Print oDoc.StoryRanges.Count
'Notice that simply referencing a header or footer (in any section) defines and expands the storyrange collection
'to include the six header and footer storyranges.
For Each oRngStory In oDoc.StoryRanges
Debug.Print oRngStory.StoryType
Next oRngStory
'Every range has at least one paragraph defined.
'Accordingly, the formally (empty) section 1 primary header and footer will now contain a paragraph mark.
'Add some text to the section 1 first page header. Note - Even if the page setup does not include a first page or even
'page header/footer, they still exist.
oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "You can't see me"
Debug.Print oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text
'Create a first page layout
oDoc.PageSetup.DifferentFirstPageHeaderFooter = True
oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "You can see me now."
'The following code similates a user clicking in the section one header (defined with a single paragraph and no text).
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
Debug.Print oDoc.StoryRanges.Count
'Notice how this action, which could easily be done by the user in with the UI, removes (and kills) the
'section 1 header and footer ranges. The paragraph marks are gone!
'More troublesome is that the six header and footer storyranges from the storyrange collection
'have also been killed as the following illustrates!!
For Each oRngStory In oDoc.StoryRanges
Debug.Print oRngStory.StoryType
Next oRngStory
'We know that there is a header range defined in section 2 because we can still see the text. This means that a header range does
'not necessarily mean a header storyrange.
'The following illustrates that in order to process all ranges, you must first ensure that all the storyranges are defined.
For Each oRngStory In oDoc.StoryRanges '(wdPrimaryHeaderStory)
Do Until oRngStory Is Nothing
Debug.Print oRngStory.Text
Set oRngStory = oRngStory.NextStoryRange
Loop
Next oRngStory
'So why was the content in the section 2 primary header not returned?
On Error GoTo Err_Handler
Set oRngStory = oDoc.StoryRanges(wdPrimaryHeaderStory)
Err_ReEntry:
For Each oRngStory In oDoc.StoryRanges '(wdPrimaryHeaderStory)
Do Until oRngStory Is Nothing
Debug.Print oRngStory.Text
Set oRngStory = oRngStory.NextStoryRange
Loop
Next oRngStory
'Since we've reference the section 1 headers and created the range, we are left with empty paragraph marks. Remove them as demostrated above.
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
oDoc.Close wdDoNotSaveChanges
Exit Sub
Err_Handler:
'There is no wdPrimaryHeaderStory so the error occurred.
'It is content in Section 1 that defines the 6 header/footer storyranges.
'To ensure they are defined (all of them) all you need to do is reference one of them:
lngJunk = oDoc.Sections(1).Headers(1).Range.StoryType
Resume Err_ReEntry
'What I've learned is that lngJunk and the reference to the section 1 header does "NOT" ensure that skipped headers are processed.
'It is actually section 1 that defines the storyrange collection.
End Sub
[/VBA]
'It is actually section 1 that defines the storyrange collection.
Indeed, and there is always a Section 1, although its content may not always be what you intended to start with, vis-a- vis the deletion of Section later, working backwards.
Gotta love this stuff.
¸
'Isolate section 2 header and footers from section 1.
For i = 1 To 3
oDoc.Sections(2).Headers(i).LinkToPrevious = False
oDoc.Sections(2).Headers(i).LinkToPrevious = False
Next i
Does not in fact isolate headers and footers. It only isolates headers. Unless that is a typo and it should be...
'Isolate section 2 header and footers from section 1.
For i = 1 To 3
oDoc.Sections(2).Headers(i).LinkToPrevious = False
oDoc.Sections(2).Footers(i).LinkToPrevious = False
Next i
BTW that is one of the standard operations that I have as a procedure to Call.
It is a typo :-(
I figured. Just a little razzin'. I knew you would not be doubling lines of instructions, you are way too good for that.
lngJunk = oDocToProcess.Sections(1).Headers(1).Range.StoryType
Can anyone explain why setting a long variable equal to a storytype value results in the physical change in the header (i.e., going from blank/empty to containing an empty paragraph)?
Hmmm. I would call it the Heisenberg variable........ the mere act of observation changes the results.
I came to this thread when trying to understand anomolies when clearing out a textframe in footers of converted PDFs of weekly public notices. I wanted to remove the shaperange containing the textframe and then add a standard footer of "Public Notice [tab] Issue Date [tab] Page #". No problem deleting the shaperange but the insertion (rng.TEXT) of the standard text caused it to disappear off screen. Blindly trying to delete any hidden paragraph marks before inserting my standard footer text, I found, that doing a .select on the range caused the display to flip, annoyingly, to Outline View.
Finally fell into a kludge of using MOVEUNTIL (twice) to select and delete the hidden paragraph marks, so insertion of my standard text now appeared on screen. A lot of work to work around the hidden nature of Word. And once again reinforces the power of the paragraph mark.
Thanks, to all you MVPs in VBA for helping to make the mysterious knowable. Be damned, Heisenberg!
Posting Permissions
