From: Graham Mayor on
That first possibility occurred to me after I posted, but I was going out to
a festive party, so I did not pursue it further. Now back, with a hangover,
I might be inclined to explore it further.

Regarding the second point, I took the OP at his word that he meant 'word'
and not 'words' (always a risky thing to do), but felt it possible that
there may be a couple of words and I allowed for that. The macro should
report the font name, though hopefully there would not be more than one font
in the range.

They were not the only problems I could think of either. I suspect that the
OP wants the highlighted word formatted as it appears in the document when
it is reproduced in the extract. This is fiddly to achieve without copy and
paste - and in any case then I wonder at the point of it. If the plan was to
identify words that had not been completely highlighted it would be simpler
to correct that with the macro before extracting the data and have no
partially formatted words.

I'll wait and see what the OP has to say before playing further - to give
the hangover time to fade ;) - when we might learn the point of the
exercise, which might then point to a different approach entirely.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


"DaveLett" <DaveLett(a)discussions.microsoft.com> wrote in message
news:BBD90143-59BE-42B9-8A93-955D82953E1F(a)microsoft.com...
> Hi all,
> I was reading/testing Graham's post to see if I could learn something new,
> and I think I might have found a couple of issues, which are probably just
> rare occurrences anyway.
>
> 1) The line ".End = .Words.Last.End - 1" presumes (I think) that the word
> ends with a space after it. When I run the routine in a test document, any
> word that is highlighted and followed by a punctuation mark or paragraph,
> the
> routine reports as partially highlighted.
>
> 2) In the very outside chance the that highlighted word is actually a
> group
> of words, then the routine doesn't "report" the font name.
>
> All of this is just FYI and FWIW,
>
> Dave


From: andreas on
On 29 Dez., 08:59, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote:
> That first possibility occurred to me after I posted, but I was going out to
> a festive party, so I did not pursue it further. Now back, with a hangover,
> I might be inclined to explore it further.
>
> Regarding the second point, I took the OP at his word that he meant 'word'
> and not 'words' (always a risky thing to do), but felt it possible that
> there may be a couple of words and I allowed for that. The macro should
> report the font name, though hopefully there would not be more than one font
> in the range.
>
> They were not the only problems I could think of either. I suspect that the
> OP wants the highlighted word formatted as it appears in the document when
> it is reproduced in the extract. This is fiddly to achieve without copy and
> paste - and in any case then I wonder at the point of it. If the plan was to
> identify words that had not been completely highlighted it would be simpler
> to correct that with the macro before extracting the data and have no
> partially formatted words.
>
> I'll wait and see what the OP has to say before playing further - to give
> the hangover time to fade ;) - when we might learn the point of the
> exercise, which might then point to a different approach entirely.
>
> --
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> Graham Mayor -  Word MVP
>
> My web sitewww.gmayor.com
> Word MVP web sitehttp://word.mvps.org
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>
> "DaveLett" <DaveL...(a)discussions.microsoft.com> wrote in message
>
> news:BBD90143-59BE-42B9-8A93-955D82953E1F(a)microsoft.com...
>
>
>
> > Hi all,
> > I was reading/testing Graham's post to see if I could learn something new,
> > and I think I might have found a couple of issues, which are probably just
> > rare occurrences anyway.
>
> > 1) The line ".End = .Words.Last.End - 1" presumes (I think) that the word
> > ends with a space after it. When I run the routine in a test document, any
> > word that is highlighted and followed by a punctuation mark or paragraph,
> > the
> > routine reports as partially highlighted.
>
> > 2) In the very outside chance the that highlighted word is actually a
> > group
> > of words, then the routine doesn't "report" the font name.
>
> > All of this is just FYI and FWIW,
>
> > Dave- Zitierten Text ausblenden -
>
> - Zitierten Text anzeigen -

Hi Graham and Dave,

I am really very impressed by the professionalism with which you
tackle/sort out VBA problems. This forum is more than terrific.

I am getting back soon with a detailed analysis.

Regards, Andreas
From: Graham Mayor on
The following takes care of the issues raised by Dave and the one I raised
myself. It gets no prizes for elegant coding, but should do the job?

Dim oRng As Range
Dim oNRng As Range
Dim oSource As Document
Dim oDoc As Document
Dim iPage As Integer
Dim iLen As Integer
Dim iPara As Integer
Dim iIst As Integer
Dim iLast As Integer
Dim sFont As String
Dim sComp As String
Dim sNext As String
Dim sWords As String
Dim sColor As WdColor
Set oSource = ActiveDocument
Set oDoc = Documents.Add
oSource.Activate
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Highlight = True
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
Do While .Execute = True
Set oRng = Selection.Range
With oRng
iIst = .Start - .Words.First.Start + 1
iLast = .Words.Last.End - .End
sNext = .Next.Characters(1)
sColor = .HighlightColorIndex
If .Start <> .Words.First.Start Or _
.End <> .Words.Last.End - 1 And _
sNext <> "" Then
Select Case sNext
Case ",", ".", "?", "!", ":", ";"
sComp = ""
iLast = iLast + 1
Case Else
sComp = ", Partly highlighted"
End Select
Else
sComp = ""
End If
.Start = .Words.First.Start
.End = .Words.Last.End
If .Characters.Last = Chr(32) Then
.End = .Words.Last.End - 1
End If
.Copy
sFont = .Font.name
iPage = .Information(wdActiveEndPageNumber)
oDoc.Range.InsertAfter oRng.Text & _
", Page " & _
iPage & ", Name: " _
& sFont & sComp & vbCr
iPara = oDoc.Paragraphs.Count - 1
iLen = InStr(1, oDoc.Paragraphs(iPara).Range.Text, ",")
For i = iIst To iLen - iLast
oDoc.Paragraphs(iPara).Range.Characters(i).HighlightColorIndex
= sColor
Next i
End With
Loop
End With
End With
With oDoc.Range
.Paragraphs.Last.Range.Delete
End With
oDoc.Activate


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


"andreas" <andreas.hermle(a)gmx.de> wrote in message
news:77082fa1-4e2e-469b-a89a-61effbb4ad60(a)a21g2000yqc.googlegroups.com...
On 29 Dez., 08:59, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote:
> That first possibility occurred to me after I posted, but I was going out
> to
> a festive party, so I did not pursue it further. Now back, with a
> hangover,
> I might be inclined to explore it further.
>
> Regarding the second point, I took the OP at his word that he meant 'word'
> and not 'words' (always a risky thing to do), but felt it possible that
> there may be a couple of words and I allowed for that. The macro should
> report the font name, though hopefully there would not be more than one
> font
> in the range.
>
> They were not the only problems I could think of either. I suspect that
> the
> OP wants the highlighted word formatted as it appears in the document when
> it is reproduced in the extract. This is fiddly to achieve without copy
> and
> paste - and in any case then I wonder at the point of it. If the plan was
> to
> identify words that had not been completely highlighted it would be
> simpler
> to correct that with the macro before extracting the data and have no
> partially formatted words.
>
> I'll wait and see what the OP has to say before playing further - to give
> the hangover time to fade ;) - when we might learn the point of the
> exercise, which might then point to a different approach entirely.
>
> --
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
> Graham Mayor - Word MVP
>
> My web sitewww.gmayor.com
> Word MVP web sitehttp://word.mvps.org
> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>
> "DaveLett" <DaveL...(a)discussions.microsoft.com> wrote in message
>
> news:BBD90143-59BE-42B9-8A93-955D82953E1F(a)microsoft.com...
>
>
>
> > Hi all,
> > I was reading/testing Graham's post to see if I could learn something
> > new,
> > and I think I might have found a couple of issues, which are probably
> > just
> > rare occurrences anyway.
>
> > 1) The line ".End = .Words.Last.End - 1" presumes (I think) that the
> > word
> > ends with a space after it. When I run the routine in a test document,
> > any
> > word that is highlighted and followed by a punctuation mark or
> > paragraph,
> > the
> > routine reports as partially highlighted.
>
> > 2) In the very outside chance the that highlighted word is actually a
> > group
> > of words, then the routine doesn't "report" the font name.
>
> > All of this is just FYI and FWIW,
>
> > Dave- Zitierten Text ausblenden -
>
> - Zitierten Text anzeigen -

Hi Graham and Dave,

I am really very impressed by the professionalism with which you
tackle/sort out VBA problems. This forum is more than terrific.

I am getting back soon with a detailed analysis.

Regards, Andreas


From: Greg Maxey on
Graham,

Seeking no prizes either and just offering a different slant. I notice in
your version you include a ".copy" but not a paste. Using a paste and a
little fiddling with the range you can duplicate the formatting in the
document (if as you say there is a point or need for that).

Sub ScratchMaco()
Dim oSource As Word.Document, oListDoc As Word.Document
Dim oRng As Word.Range, oListRng As Word.Range
Dim sFont As String, sComp As String
Dim sNext As String, sPrevious As String
Dim bCompStart As Boolean, bCompEnd As Boolean
Dim iPage As Long
Set oSource = ActiveDocument
Set oListDoc = Documents.Add
Set oListRng = oListDoc.Range
oSource.Activate
oSource.Range(0, 0).Select
Set oRng = oSource.Range
With oRng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
.Forward = True
.Wrap = wdFindStop
.Format = True
Do While .Execute = True
With oRng
bCompStart = False
bCompEnd = False
On Error Resume Next
sPrevious = oRng.Characters.First.Previous
'Errors if range start is at beginning of document (no previous
character exists).
If Err.Number = 91 Then
bCompStart = True
Else
Select Case sPrevious
'Previous charactesr is a space, tab, or paragraph mark or line
feed.
Case Chr(32), Chr(13), Chr(11), Chr(10), Chr(9)
bCompStart = True
Case Else
'Do nothing
End Select
End If
On Error GoTo 0
sNext = oRng.Characters.Last.Next
Select Case sNext
Case ",", ".", "?", "!", ":", ";", " "
bCompEnd = True
Case Chr(13), Chr(11), Chr(10), Chr(9)
bCompEnd = True
Case Else
'Do nothing
End Select
If bCompStart And bCompEnd Then
sComp = ""
Else
sComp = ", partially highlighted"
End If
sFont = .Font.Name
If Len(sFont) < 1 Then sFont = "Mixed fonts detected. Name not
determined."
iPage = .Information(wdActiveEndPageNumber)
.Start = .Words.First.Start
.End = .Words.Last.End
.Copy
.Collapse wdCollapseEnd
With oListRng
.Collapse wdCollapseEnd
.InsertAfter ","
.End = .End - 1
.Paste
.Start = .End + 1
.Text = " Page " & iPage & ", Name: " & sFont & sComp & vbCr
.HighlightColorIndex = wdAuto
End With
End With
Loop
End With
End With
oListDoc.Range.Paragraphs.Last.Range.Delete
oListDoc.Activate
End Sub


Graham Mayor wrote:
> The following takes care of the issues raised by Dave and the one I
> raised myself. It gets no prizes for elegant coding, but should do
> the job?
> Dim oRng As Range
> Dim oNRng As Range
> Dim oSource As Document
> Dim oDoc As Document
> Dim iPage As Integer
> Dim iLen As Integer
> Dim iPara As Integer
> Dim iIst As Integer
> Dim iLast As Integer
> Dim sFont As String
> Dim sComp As String
> Dim sNext As String
> Dim sWords As String
> Dim sColor As WdColor
> Set oSource = ActiveDocument
> Set oDoc = Documents.Add
> oSource.Activate
> With Selection
> .HomeKey Unit:=wdStory
> With .Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .Text = ""
> .Highlight = True
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindContinue
> .Format = True
> .MatchCase = False
> .MatchWholeWord = False
> .MatchAllWordForms = False
> .MatchSoundsLike = False
> .MatchWildcards = False
> Do While .Execute = True
> Set oRng = Selection.Range
> With oRng
> iIst = .Start - .Words.First.Start + 1
> iLast = .Words.Last.End - .End
> sNext = .Next.Characters(1)
> sColor = .HighlightColorIndex
> If .Start <> .Words.First.Start Or _
> .End <> .Words.Last.End - 1 And _
> sNext <> "" Then
> Select Case sNext
> Case ",", ".", "?", "!", ":", ";"
> sComp = ""
> iLast = iLast + 1
> Case Else
> sComp = ", Partly highlighted"
> End Select
> Else
> sComp = ""
> End If
> .Start = .Words.First.Start
> .End = .Words.Last.End
> If .Characters.Last = Chr(32) Then
> .End = .Words.Last.End - 1
> End If
> .Copy
> sFont = .Font.name
> iPage = .Information(wdActiveEndPageNumber)
> oDoc.Range.InsertAfter oRng.Text & _
> ", Page " & _
> iPage & ", Name: " _
> & sFont & sComp & vbCr
> iPara = oDoc.Paragraphs.Count - 1
> iLen = InStr(1, oDoc.Paragraphs(iPara).Range.Text, ",")
> For i = iIst To iLen - iLast
>
> oDoc.Paragraphs(iPara).Range.Characters(i).HighlightColorIndex =
> sColor Next i
> End With
> Loop
> End With
> End With
> With oDoc.Range
> .Paragraphs.Last.Range.Delete
> End With
> oDoc.Activate
>
>
>
> "andreas" <andreas.hermle(a)gmx.de> wrote in message
> news:77082fa1-4e2e-469b-a89a-61effbb4ad60(a)a21g2000yqc.googlegroups.com...
> On 29 Dez., 08:59, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote:
>> That first possibility occurred to me after I posted, but I was
>> going out to
>> a festive party, so I did not pursue it further. Now back, with a
>> hangover,
>> I might be inclined to explore it further.
>>
>> Regarding the second point, I took the OP at his word that he meant
>> 'word' and not 'words' (always a risky thing to do), but felt it
>> possible that there may be a couple of words and I allowed for that.
>> The macro should report the font name, though hopefully there would
>> not be more than one font
>> in the range.
>>
>> They were not the only problems I could think of either. I suspect
>> that the
>> OP wants the highlighted word formatted as it appears in the
>> document when it is reproduced in the extract. This is fiddly to
>> achieve without copy and
>> paste - and in any case then I wonder at the point of it. If the
>> plan was to
>> identify words that had not been completely highlighted it would be
>> simpler
>> to correct that with the macro before extracting the data and have no
>> partially formatted words.
>>
>> I'll wait and see what the OP has to say before playing further - to
>> give the hangover time to fade ;) - when we might learn the point of
>> the exercise, which might then point to a different approach
>> entirely. --
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>> Graham Mayor - Word MVP
>>
>> My web sitewww.gmayor.com
>> Word MVP web sitehttp://word.mvps.org
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>
>> "DaveLett" <DaveL...(a)discussions.microsoft.com> wrote in message
>>
>> news:BBD90143-59BE-42B9-8A93-955D82953E1F(a)microsoft.com...
>>
>>
>>
>>> Hi all,
>>> I was reading/testing Graham's post to see if I could learn
>>> something new,
>>> and I think I might have found a couple of issues, which are
>>> probably just
>>> rare occurrences anyway.
>>
>>> 1) The line ".End = .Words.Last.End - 1" presumes (I think) that the
>>> word
>>> ends with a space after it. When I run the routine in a test
>>> document, any
>>> word that is highlighted and followed by a punctuation mark or
>>> paragraph,
>>> the
>>> routine reports as partially highlighted.
>>
>>> 2) In the very outside chance the that highlighted word is actually
>>> a group
>>> of words, then the routine doesn't "report" the font name.
>>
>>> All of this is just FYI and FWIW,
>>
>>> Dave- Zitierten Text ausblenden -
>>
>> - Zitierten Text anzeigen -
>
> Hi Graham and Dave,
>
> I am really very impressed by the professionalism with which you
> tackle/sort out VBA problems. This forum is more than terrific.
>
> I am getting back soon with a detailed analysis.
>
> Regards, Andreas


From: Greg Maxey on
I think my first attempt involved some over kill as I was half way through
it before I realized the OP wanted to list the whole of partically
highlighted words. Rev 2:

Sub ScratchMaco()
Dim oSource As Word.Document, oListDoc As Word.Document
Dim oRng As Word.Range, oListRng As Word.Range
Dim sFont As String, sComp As String
Dim bCompStart As Boolean, bCompEnd As Boolean
Dim iPage As Long
Set oSource = ActiveDocument
Set oListDoc = Documents.Add
Set oListRng = oListDoc.Range
oSource.Activate
oSource.Range(0, 0).Select
Set oRng = oSource.Range
With oRng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
.Forward = True
.Wrap = wdFindStop
.Format = True
Do While .Execute = True
With oRng
bCompStart = False
bCompEnd = False
If .Start = .Words(1).Start Then bCompStart = True
If .End = .Words(.Words.Count).End Then bCompEnd = True
sComp = ""
If Not bCompStart Or Not bCompEnd Then sComp = ", partially
highlighted"
sFont = .Font.Name
If Len(sFont) < 1 Then sFont = "Mixed fonts detected and a specific
name is not determined"
iPage = .Information(wdActiveEndPageNumber)
.Start = .Words.First.Start
.End = .Words.Last.End
.Copy
.Collapse wdCollapseEnd
With oListRng
.Collapse wdCollapseEnd
.InsertAfter ","
.End = .End - 1
.Paste
.Start = .End + 1
.Text = " Page " & iPage & ", Name: " & sFont & sComp & vbCr
.HighlightColorIndex = wdAuto
End With
End With
Loop
End With
End With
oListDoc.Range.Paragraphs.Last.Range.Delete
oListDoc.Activate
End Sub


Graham Mayor wrote:
> The following takes care of the issues raised by Dave and the one I
> raised myself. It gets no prizes for elegant coding, but should do
> the job?
> Dim oRng As Range
> Dim oNRng As Range
> Dim oSource As Document
> Dim oDoc As Document
> Dim iPage As Integer
> Dim iLen As Integer
> Dim iPara As Integer
> Dim iIst As Integer
> Dim iLast As Integer
> Dim sFont As String
> Dim sComp As String
> Dim sNext As String
> Dim sWords As String
> Dim sColor As WdColor
> Set oSource = ActiveDocument
> Set oDoc = Documents.Add
> oSource.Activate
> With Selection
> .HomeKey Unit:=wdStory
> With .Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .Text = ""
> .Highlight = True
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindContinue
> .Format = True
> .MatchCase = False
> .MatchWholeWord = False
> .MatchAllWordForms = False
> .MatchSoundsLike = False
> .MatchWildcards = False
> Do While .Execute = True
> Set oRng = Selection.Range
> With oRng
> iIst = .Start - .Words.First.Start + 1
> iLast = .Words.Last.End - .End
> sNext = .Next.Characters(1)
> sColor = .HighlightColorIndex
> If .Start <> .Words.First.Start Or _
> .End <> .Words.Last.End - 1 And _
> sNext <> "" Then
> Select Case sNext
> Case ",", ".", "?", "!", ":", ";"
> sComp = ""
> iLast = iLast + 1
> Case Else
> sComp = ", Partly highlighted"
> End Select
> Else
> sComp = ""
> End If
> .Start = .Words.First.Start
> .End = .Words.Last.End
> If .Characters.Last = Chr(32) Then
> .End = .Words.Last.End - 1
> End If
> .Copy
> sFont = .Font.name
> iPage = .Information(wdActiveEndPageNumber)
> oDoc.Range.InsertAfter oRng.Text & _
> ", Page " & _
> iPage & ", Name: " _
> & sFont & sComp & vbCr
> iPara = oDoc.Paragraphs.Count - 1
> iLen = InStr(1, oDoc.Paragraphs(iPara).Range.Text, ",")
> For i = iIst To iLen - iLast
>
> oDoc.Paragraphs(iPara).Range.Characters(i).HighlightColorIndex =
> sColor Next i
> End With
> Loop
> End With
> End With
> With oDoc.Range
> .Paragraphs.Last.Range.Delete
> End With
> oDoc.Activate
>
>
>
> "andreas" <andreas.hermle(a)gmx.de> wrote in message
> news:77082fa1-4e2e-469b-a89a-61effbb4ad60(a)a21g2000yqc.googlegroups.com...
> On 29 Dez., 08:59, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote:
>> That first possibility occurred to me after I posted, but I was
>> going out to
>> a festive party, so I did not pursue it further. Now back, with a
>> hangover,
>> I might be inclined to explore it further.
>>
>> Regarding the second point, I took the OP at his word that he meant
>> 'word' and not 'words' (always a risky thing to do), but felt it
>> possible that there may be a couple of words and I allowed for that.
>> The macro should report the font name, though hopefully there would
>> not be more than one font
>> in the range.
>>
>> They were not the only problems I could think of either. I suspect
>> that the
>> OP wants the highlighted word formatted as it appears in the
>> document when it is reproduced in the extract. This is fiddly to
>> achieve without copy and
>> paste - and in any case then I wonder at the point of it. If the
>> plan was to
>> identify words that had not been completely highlighted it would be
>> simpler
>> to correct that with the macro before extracting the data and have no
>> partially formatted words.
>>
>> I'll wait and see what the OP has to say before playing further - to
>> give the hangover time to fade ;) - when we might learn the point of
>> the exercise, which might then point to a different approach
>> entirely. --
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>> Graham Mayor - Word MVP
>>
>> My web sitewww.gmayor.com
>> Word MVP web sitehttp://word.mvps.org
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>
>> "DaveLett" <DaveL...(a)discussions.microsoft.com> wrote in message
>>
>> news:BBD90143-59BE-42B9-8A93-955D82953E1F(a)microsoft.com...
>>
>>
>>
>>> Hi all,
>>> I was reading/testing Graham's post to see if I could learn
>>> something new,
>>> and I think I might have found a couple of issues, which are
>>> probably just
>>> rare occurrences anyway.
>>
>>> 1) The line ".End = .Words.Last.End - 1" presumes (I think) that the
>>> word
>>> ends with a space after it. When I run the routine in a test
>>> document, any
>>> word that is highlighted and followed by a punctuation mark or
>>> paragraph,
>>> the
>>> routine reports as partially highlighted.
>>
>>> 2) In the very outside chance the that highlighted word is actually
>>> a group
>>> of words, then the routine doesn't "report" the font name.
>>
>>> All of this is just FYI and FWIW,
>>
>>> Dave- Zitierten Text ausblenden -
>>
>> - Zitierten Text anzeigen -
>
> Hi Graham and Dave,
>
> I am really very impressed by the professionalism with which you
> tackle/sort out VBA problems. This forum is more than terrific.
>
> I am getting back soon with a detailed analysis.
>
> Regards, Andreas