Left position property of Range in Word doc?

[realbear]

:think: HI
I have coded some VBA to scan through a Word document, defining .Start and .End of ranges in which to look at the textual content and possibily change the Formatting.
Everything functions very well, only sometimes, it scans text I didn't want it to scan. The substrate document is essentially laid out in 3 columns - though only by tabs (as a by product of publishing an MS Access Report in Word).
What would help would be a way to know the Left position of any range of text (it is only text in the right hand column that I might want to want to format: i.e. if the Left postion is large enough)

Is there any way to know the absolute Left position of a Range in a Word document?

Hope someone can help

realbear

[realbear]

:cloud9:
Hi

Herewith some code that analyses and colours in a Word document that demarks the start of some children with the ` character with each child (including the last in the sequence) ending in a semi colon ;

I attach some sample data (the original would be HIGHLY confidential - pathologically so!). I have also since decided that I can change the MS Access report (generating the sample data) to include a flag character in the partner's (e.g. ? ) which, if found in the range short circuits the ColourInKids() procedure
Dim doc As Range, KidsStart As Long, KidsEnd As Long
Sub ColouredKids()
Set doc = ActiveDocument.Range
ScourAllKids
End Sub
Sub ScourAllKids()
Dim KidBlip As Range
Set KidBlip = ActiveDocument.Range
KidBlip.Find.Execute findtext:="`"
While KidBlip.Find.Found
KidsStart = KidBlip.Start + 1
EstablishExtentOfKids
ColourInKids
KidBlip.Find.Execute findtext:="`"
Wend
GetRidOf "`;"
GetRidOf "`"
ColourSpecificText "17+", wdViolet
ColourSpecificText "12-16", wdBlue
ColourSpecificText "5-11", wdGreen
ColourSpecificText "under 5s", wdRed

End Sub
Sub EstablishExtentOfKids() 'look for NEXT Blip
Dim Kids As Range
Set Kids = ActiveDocument.Range(KidsStart, doc.End)
Kids.Find.Execute findtext:="`"
'if THERE say end of Kids is JUST BEFORE it
If Kids.Find.Found Then
KidsEnd = Kids.Start - 1
Else 'if NOT THERE say end of Kids is end of doc
KidsEnd = doc.End
End If
End Sub
Sub ColourInKids()
Dim Kids As Range, NextKid As Range, strKidDOB, KidDOB As Date
Dim AnyMorekids As Boolean
Set NextKid = ActiveDocument.Range(doc.Start, doc.Start)
AnyMorekids = True
While AnyMorekids
Set NextKid = GetNextKid()
If Not NextKid Is Nothing Then
'If InStr(1, NextKid.Text, "NANCY 31/07/1990") Then Stop
strKidDOB = FindDateof(NextKid)
KidDOB = CDate(strKidDOB)
NextKid.Font.ColorIndex = AgeRangeColour(KidDOB)
KidsStart = NextKid.End + 1 'IIf(NextKid.End < doc.End - 1, NextKid.End + 1, doc.End - 2)
Else
If KidsEnd < doc.End Then
Set NextKid = ActiveDocument.Range(KidsEnd, KidsEnd)
AnyMorekids = NextKid.Start < KidsEnd
Else
AnyMorekids = False
End If
End If

Wend
End Sub
Function GetNextKid()
Dim SemiStart As Long, semicolon As Range
Set semicolon = ActiveDocument.Range(KidsStart, KidsEnd)
semicolon.Find.Execute findtext:=";"
If semicolon.Find.Found Then
Set GetNextKid = ActiveDocument.Range(KidsStart, semicolon.Start)
Else
Set GetNextKid = Nothing
End If
End Function
Function FindDateof(kid As Range)
Dim NextWd As Range, w As Long, wd As String
For w = 1 To kid.Words.Count
wd = kid.Words(w)
If IsNumeric(wd) Then
If kid.Words.Count - w >= 3 Then
If NextFourWdsMakesDate(kid, w) Then
FindDateof = FiveWdsStartingAt(w, kid)
Exit Function
End If
End If
End If
Next
End Function
Function NextFourWdsMakesDate(kid As Range, w As Long)
NextFourWdsMakesDate = kid.Words(w + 1) & kid.Words(w + 3) = "//" And IsNumeric(kid.Words(w + 2) & kid.Words(w + 4))
End Function
Function FiveWdsStartingAt(w As Long, kid As Range)
FiveWdsStartingAt = kid.Words(w) & kid.Words(w + 1) & kid.Words(w + 2) & kid.Words(w + 3) & kid.Words(w + 4)
End Function
Function AgeRangeColour(DOB As Date) As Long
Dim DOBasDaysAgo As Long
DOBasDaysAgo = CLng(Date - DOB)
If DOBasDaysAgo >= 17 * 365 Then
AgeRangeColour = wdViolet
Else
If DOBasDaysAgo < 17 * 365 And DOBasDaysAgo >= 12 * 365 Then
AgeRangeColour = wdBlue
Else
If DOBasDaysAgo < 12 * 365 And DOBasDaysAgo >= 5 * 365 Then
AgeRangeColour = wdGreen
Else
AgeRangeColour = wdRed
End If
End If
End If
End Function
Sub GetRidOf(old_text)
With ActiveDocument.Range.Find
.Font.ColorIndex = wdAuto
.Text = old_text
'Match whole word
.MatchWholeWord = True
'Just stop if not found by end of document
.Wrap = wdFindStop
.Replacement.Text = ""
'Replace All of them
.Execute Replace:=wdReplaceAll
End With 'ActiveDocument.Range.Find
End Sub
Sub ColourSpecificText(subj_text, clr)
With ActiveDocument.Range.Find
.Font.ColorIndex = wdAuto
.Text = subj_text
.MatchCase = True
'Match whole word only if not looking for two words
.MatchWholeWord = InStr(1, subj_text, " ", _
vbBinaryCompare) = 0
'Just stop if not found by end of document
.Wrap = wdFindStop
'replace as bold blue version
.Replacement.Text = subj_text
.Replacement.Font.Bold = True
.Replacement.Font.ColorIndex = clr
'Replace All of them
.Execute Replace:=wdReplaceAll
End With 'ActiveDocument.Range.Find
End Sub

[realbear]

:hi:
Hi
BTW I have just noticed that there are really FIVE column - not three.

The idea is to publish the MS Access report in Word and then, when in Word (with the VBA code, here, in Word's Normal) I would run macro "ColouredKids".

The routine ColouredKids() completes successfully and colours the children (in "column five") according to the found and analysed date of birth, takes out some of the demarkation characters (e.g. `; and ` ) and colour codes the report's grouping footer (there are other pages of other caravan sites) so that the human reader can use it as a colour key to pick out children (in "column five") of particular age groups.

The problem is that the MS Access report has a text box for Partners (in "column four") with the "Can grow" property set to true: if the entry is long enough it will go to the next line and, potentially, become includable with a multiline entry for the children (in "column five"). The VBA code, here, would also, quite likely, get the colour coding wrong as the partner's date of birth will be used to determine the colour. In the sample data, this has happened for the partner on plots 6 and 15.

Attempts to put everything in columns proved highly unsatisfactory. One thing I notice is that, where the partner stays on one line, a Line Feed to the next line of children results in a great long tab of 11cm or so. Should a partner wrap to an addtional line, the resulting Line Feed would be much less (6.5 cm or so).

The routine ColourInKids() needs to do a concurrent analysis of the paragrahs in the global range Kids [ set in the routine EstablishExtentOfKids() ]. Where a tabstop's .Position property equates to less than 11cm, ColourInKids' code needs to split NextKid into two ranges; the first range would end at the Line Feed; the second range would end where NextKid did; the START of at the second range would be determined by looking for a tabstop with a .Position equating to at least 11cm.

I will have play (in a while) with the above concept.

Regards

realbear