Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Word / Programming / January 2006

Tip: Looking for answers? Try searching our database.

StoryRanges, finding headers/footers

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Ed - 21 Jan 2006 13:13 GMT
I have a document in which I need to determine the various story ranges to
perform certain actions. The document has two sections. The first section
has no headers, the second does.

When I query something like:
   for each oStory in ActiveDocument.StoryRanges
        If oStory.StoryType = wdFooterStory  then
           msgbox "There is a Footnote"
       Elseif oStory.StoryType=wdHeaderStory then
           msgbox "There is a Footnote"
       (etc. thru all the stories)
next

the Header story is not found (the footer is found) even though there is
definitely a header in my document. (The view is set to wdPrintView, an
apparent requirement). This seems to only happen when there are sections in
the document, but the documentation in Word and on the Word site don't
suggest that sections makes any difference.

What am I doing wrong? Thanks.

-Ed
Greg Maxey - 21 Jan 2006 16:13 GMT
Ed,

Play with this:
Sub Test()
Dim oStory As Range
MakeHFValid
For Each oStory In ActiveDocument.StoryRanges
 Do
   If oStory.StoryType = wdPrimaryFooterStory Then
     MsgBox "There is a Footnote"
     MsgBox oStory
    ElseIf oStory.StoryType = wdPrimaryHeaderStory Then
     MsgBox "There is a Footnote"
     MsgBox oStory
   End If
   'Get next linked story (if any)
   Set oStory = oStory.NextStoryRange
 Loop Until oStory Is Nothing
Next
End Sub
Public Sub MakeHFValid()
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

> I have a document in which I need to determine the various story
> ranges to perform certain actions. The document has two sections. The
[quoted text clipped - 18 lines]
>
> -Ed
Ed - 22 Jan 2006 00:21 GMT
Greg,

   What on earth does that MakeHFValid routine do (except magic)? All it
seems to do is assign a value to a junk term, but it sure works.
   I changed nothing in my previous routine except adding MakeHFValid. It
now works like a charm. Wow. And thanks.

   Ed

> Ed,
>
[quoted text clipped - 43 lines]
>>
>> -Ed
Greg Maxey - 22 Jan 2006 00:31 GMT
Ed,

I am not exactly sure.  You have simply joined me in gaining from the
experience of others.  I found it in a VBA find and replace routine posted
as the work of (Peter Hewett and Doug Robbins {I think}).  As I understand
it, it somehow establishes the link across empty headers or footers in a
document.

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

> Greg,
>
[quoted text clipped - 57 lines]
>>>
>>> -Ed
Doug Robbins - Word MVP - 22 Jan 2006 08:02 GMT
All the credit, for that part of the article from where you got the routine,
is due to Peter Hewett.  Here is the original post in which I first used the
code:

Here's something that should help (makes use of some code supplied by Peter
Hewett)

Public Sub BatchReplaceAnywhere()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim FindText As String
Dim Replacement As String
' Get the folder containing the files
With Dialogs(wdDialogCopyFile)
   If .Display <> 0 Then
       PathToUse = .Directory
   Else
       MsgBox "Cancelled by User"
       Exit Sub
   End If
End With
'Close any documents that may be open
If Documents.Count > 0 Then
   Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
   'Get the text to be replaced and the replacement
   If FirstLoop = True Then
       FindText = InputBox("Enter the text that you want to replace.",
"Batch Replace Anywhere")
       Replacement = InputBox("Enter the replacement text.", "Batch Replace
Anywhere ")
       FirstLoop = False
   End If
   'Open each file and make the replacement
   Set myDoc = Documents.Open(PathToUse & myFile)
   ' Fix the skipped blank Header/Footer problem
   MakeHFValid
   ' Iterate through all story types in the current document
   For Each rngstory In ActiveDocument.StoryRanges
       ' Iterate through all linked stories
       Do
           SearchAndReplaceInStory rngstory, FindText, Replacement
           ' Get next linked story (if any)
           Set rngstory = rngstory.NextStoryRange
       Loop Until rngstory Is Nothing
   Next
   'Close the file, saving the changes.
   myDoc.Close Savechanges:=wdSaveChanges
   myFile = Dir$()
Wend
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, _
                                  ByVal strSearch As String, _
                                  ByVal strReplace As String)
'This routine supplied by Peter Hewett
   Do Until (rngstory Is Nothing)
       With rngstory.Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Text = strSearch
           .Replacement.Text = strReplace
           .Forward = True
           .Wrap = wdFindContinue
           .Format = False
           .MatchCase = False
           .MatchWholeWord = False
           .MatchAllWordForms = False
           .MatchSoundsLike = False
           .MatchWildcards = False
           .Execute Replace:=wdReplaceAll
       End With
      Set rngstory = rngstory.NextStoryRange
   Loop
End Sub

Public Sub MakeHFValid()
'And this too
   Dim lngJunk As Long
   ' It does not matter whether we access the Headers or Footers property.
   ' The critical part is accessing the stories range object
   lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Ed,
>
[quoted text clipped - 65 lines]
>>>>
>>>> -Ed
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.