Get characters before and after the selection

[dum]

Hello.

Please consult me a bit. Lets assume that I have a Selection. I'm retrieving it with the help of total search like this:



For Each storyrange In ActiveDocument.StoryRanges With storyrange.Find
.Text = <text to find>
Do While .Execute
storyrange.Select

<some analysis>
Loop
End With
Next storyrange




In <some analysis> part I need to know character just before and just after the Selection. Could you be so kind to tell me how can I retrieve them? Thanks a lot beforehand.

[gmayor]

Try the following.

Note that it is neither necessary nor desirable to select a range in order to process it, especially where that may entail opening a header footer range. Processing the story ranges in the manner you have shown is not entirely reliable. The following alternative is better, but occasionally there will be story ranges that must be declared specifically in order to process them.

It is bad practice and likely to result in errors to use VBA keywords as variable names, so use oStory or rStory instead of storyrange


Option Explicit

Sub Macro1()
Dim strFind As String: strFind = "Lorem"
Dim oStory As Range
For Each oStory In ActiveDocument.StoryRanges
With oStory.Find
.Text = strFind
Do While .Execute
ProcessRange oStory
oStory.Collapse 0
Loop
End With
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
With oStory.Find
.Text = strFind
Do While .Execute
ProcessRange oStory
oStory.Collapse 0
Loop
End With
Wend
End If
Next oStory
End Sub

Sub ProcessRange(oStory As Range)

With oStory
'oStory.Select
On Error Resume Next
MsgBox "The ASCII value of the previous character is " & Asc(oStory.Previous.Characters.Last)
If Err.Number = 91 Then
MsgBox "The text is at the start of the range"
Err.Clear
End If
MsgBox "The ASCII value of the next character is " & Asc(oStory.Next.Characters(1))
'<some analysis>
End With
End Sub

[dum]

Thanks a lot, Graham. I'm really new to VBA programming and your advises are extremely thankful. May I ask a bit more


Processing the story ranges in the manner you have shown

The manner I have shown is not based on my experience. If there is a better manner I'll eagerly switch to it. The key procedure in my processing is replacing a substring, depending on previous and next characters.
If you will offer a more advantageous manner I'll be thankful.


...is not entirely reliable. The following alternative is better, but occasionally there will be story ranges that must be declared specifically in order to process them

I need total processing, which should include headers, footers, footnotes, table entries etc. Could you tell a bit more about this lack of reliability? What kind of ranges could be missing and how to handle them?


it is neither necessary nor desirable to select a range in order to process it

And in range is not selected then what member functions do I have to edit the text within? Characters is read-only as I can see. Do I have just clipboard operations like Paste? I think there should be something else...

[gmaxey]

The manner in which you were processing storyranges is not reliable because you would miss and not process any text in linked storyranges and miss any text in shapes anchored in the header/footer storyranges.

I am not familiar with situations where "... story ranges that must be declared specifically in order to process them." Graham please advise/clarify.


Option Explicit
Public Sub ComprehensiveSearch()
Dim rngStory As Word.Range
Dim strFind As String
Dim pReplaceTxt As String
Dim lngValidatore As Long
Dim oShp As Shape
strFind = InputBox("Enter the text that you want to find.", "FIND")
If strFind = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
'Fix the skipped blank Header/Footer problem
lngValidatore = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrchInStory rngStory, strFind
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If Not oShp.TextFrame.TextRange Is Nothing Then
SrchInStory oShp.TextFrame.TextRange, strFind
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
lbl_Exit:
Exit Sub
End Sub
Public Sub SrchInStory(ByVal rngStory As Word.Range, ByVal strSearch As String)
With rngStory.Find
.ClearFormatting
.Text = strSearch
While .Execute
'The analysis:
On Error Resume Next
MsgBox "The previous character is " & Asc(rngStory.Previous.Characters.Last)
If Err.Number = 91 Then
MsgBox "The text is at the start of the range"
Err.Clear
Else
'Now lets assume that if the character before your found text is a tab
'that you want to alter the found text.
If Asc(rngStory.Previous.Characters.Last) = 9 Then
With rngStory
.Text = "Some new text"
.Font.Size = "18"
.Font.ColorIndex = wdBrightGreen
End With
End If
End If
MsgBox "The next character is " & Asc(rngStory.Next.Characters(1))
If Err.Number = 91 Then
MsgBox "The text is at the start of the range"
Err.Clear
End If
rngStory.Collapse wdCollapseEnd
Wend
End With
lbl_Exit:
Exit Sub
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

[dum]

Greg, thanks for an extremely informative skeleton sample. I'll analyse and try it.


I am not familiar with situations where "... story ranges that must be declared specifically in order to process them." Graham please advise/clarify.

Graham, this would be perfect. Help, please.

[gmaxey]

You're welcome. Graham is on your side of the Atlantic so he should be up and about shortly.

[gmayor]

I have not personally come across any instances that the code I posted would not update the fields in documents I have worked with, but having frequented forums such as this for the best part of 20 years, I have come across anecdotal evidence that suggests that some fields are reluctant to update. Whether Greg's belt and braces modification would address that I cannot say.

You asked about ranges vis à vis selections. Most of what you can do with selections you can do with ranges, but as we have no idea what '<some analysis>' entails, it is difficult to advise. Ranges do not have to be selected in order to be processed but on those few occasions where only Selection will work, you can always select the range.

[dum]

Thank you!

[gmaxey]

Graham, Dum

Unfortunately, I really don't know if my approach is all inclusive either. I just know of two specific cases where Graham's seemingly comprehensive approach will unfortunately fall short. Both are admittedly rare but certainly possible. The first case happens when the storyrange collection is not fully defined. This occurs when the primary header\footer range is empty (nothing, not even a paragraph mark) and there is text in other header/footer storyranges (e.g., section 2). This can easily occur if the users clicks in and then out of primary header/footer range when it is showing only a paragraph mark.

The second case is when there is a shape containing a textframe which is anchored to a header/footer range.


168081680616807


Note: This second case is also true with a find and replace using the UI. (You have to physically put the cursor in the anchored shape).

The attached document illustrates these cases.

[gmaxey]

Dum,

Regarding the incomplete storyrange collection, you might find this interesting. Stick it in a new blank document code module and step through using F8.


Sub StoryRangeFickleness()
'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 lngValidate As Long
Set oDoc = Documents.Add
Stop
'Step through code and switch between code and document to follow the process.
MsgBox "This document contains " & oDoc.StoryRanges.Count & " storyrange(s)."
'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
MsgBox "This document still contains " & oDoc.StoryRanges.Count & " storyrange(s)."
'Notice that adding a section does not 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).Footers(i).LinkToPrevious = False
Next i
MsgBox "This document contains " & oDoc.StoryRanges.Count & " storyrange(s)."
'Notice that simply referencing a header or footer storyrange (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 single paragraph mark.
'Add some text to the section 2 primary header.
oDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Text = "Section 2 Header text"
'The following code similates a user clicking in the section one header and then back in the document.
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
'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!!
MsgBox "This document contains " & oDoc.StoryRanges.Count & " storyrange(s)."
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.
'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
'Again, just referencing the header storyRange creates the 6 header/footer storyranges.
MsgBox "This document contains " & oDoc.StoryRanges.Count & " storyrange(s)."

'Create a first page layout
oDoc.PageSetup.DifferentFirstPageHeaderFooter = True
oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "You can see me now."
'Expand the section 1 and section 2 main text storyRange to include two pages of content.
For i = 1 To 75
oDoc.Sections(1).Range.InsertBefore vbCr
Next i
oDoc.Sections(2).Range.Text = String(75, vbCr)
'Again, our user maliciously or inadvertently kills the storyrange collection.
oDoc.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
oDoc.ActiveWindow.View.SeekView = wdSeekMainDocument
MsgBox "This document contains " & oDoc.StoryRanges.Count & " storyrange(s)."
'Look at the section 1 primary header storyrange. It is empty (contains no paragraph mark).
'The following illustrates that in order to process all ranges, you must first ensure that all the storyranges are defined.
'A failed text:
For Each oRngStory In oDoc.StoryRanges
Do Until oRngStory Is Nothing
Debug.Print oRngStory.Text
Set oRngStory = oRngStory.NextStoryRange
Loop
Next oRngStory
'So why was'nt the content in the section 2 primary header returned?
On Error GoTo Err_Handler
Set oRngStory = oDoc.StoryRanges(wdPrimaryHeaderStory)
Err_ReEntry:
For Each oRngStory In oDoc.StoryRanges
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:
lngValidate = oDoc.Sections(1).Headers(1).Range.StoryType
Resume Err_ReEntry
End Sub

[dum]

Thank you, Greg, for such a detailed explanation! I'll study the code.

[gmaxey]

Keep tissue handy. Your eyes may begin to bleed.

[gmaxey]

If you are interested, there is another approach that doesn't rely on the problematic header/footer storyranges. See attached.

[dum]

Perfect, thanks a lot!