Prev: Different results from counts ... why?
Next: save as docx from office 2003
From: Graham Mayor on 30 Dec 2009 01:36
The .Copy was an artifact from an earlier iteration of the macro while
testing. I was seeking to copy the formatted text to the target document, so
as not to have to reformat it later as you correctly surmise - but I later
chose not to and the .Copy line was overlooked. It does nothing useful and
can be deleted.
The whole thing was merely an exercise to pass the time on a particularly
quiet day.
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

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


"Greg Maxey" <gmaxey(a)mIKEvICTORpAPAsIERRA.oSCARrOMEOgOLF> wrote in message
news:%230urWFKiKHA.4872(a)TK2MSFTNGP05.phx.gbl...
> 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: Graham Mayor on 30 Dec 2009 03:38
While the font name trap line is a handy addition, your version of the macro
marks all the highlighted words in my test sample as partially highted -
back to the drawing board ;)

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

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


"Greg Maxey" <gmaxey(a)mIKEvICTORpAPAsIERRA.oSCARrOMEOgOLF> wrote in message
news:ONCoLlNiKHA.2184(a)TK2MSFTNGP04.phx.gbl...
>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
>
>


From: Greg Maxey on 30 Dec 2009 07:19
Graham,

Yep you are right. I trimmed to much and was using poor example text.
Culprit was the trailing space character in the .Word.Range. This should
sort it out:

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
.Start = .Words.First.Start
Select Case .Words(.Words.Count).Characters.Last
Case Is = Chr(32)
If .End = .Words(.Words.Count).End - 1 Then bCompEnd = True
Case Else
If .End = .Words(.Words.Count).End Then bCompEnd = True
.End = .Words.Last.End
End Select
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)
.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:
> While the font name trap line is a handy addition, your version of
> the macro marks all the highlighted words in my test sample as
> partially highted - back to the drawing board ;)
>
>
> "Greg Maxey" <gmaxey(a)mIKEvICTORpAPAsIERRA.oSCARrOMEOgOLF> wrote in
> message news:ONCoLlNiKHA.2184(a)TK2MSFTNGP04.phx.gbl...
>> 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


From: DaveLett on 30 Dec 2009 09:06
Hi,
Just out of curiosity...
Would it be more efficient to use .FormattedText on the range objects
instead of .Copy and .Paste? From my test, doing so would change the
following:

iPage = .Information(wdActiveEndPageNumber)
..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

To the following:
iPage = .Information(wdActiveEndPageNumber)
With oListRng
..Collapse wdCollapseEnd
..FormattedText = oRng.FormattedText
..Start = .End + 1
..InsertAfter Text:=", Page " & iPage & ", Name: " & sFont & sComp & vbCr
..HighlightColorIndex = wdAuto
End With
..Collapse wdCollapseEnd

Thanks,
Dave
From: Graham Mayor on 30 Dec 2009 09:30
That works too, but whether it is any more efficient than Greg's method or
mine, I hestitate to guess. Certainly there is little difference in speed on
my test sample, but that doesn't run to a couple of hundred pages like that
of the OP. It just shows that there is more than one way to skin a rabbit.
At the end of the day I will settle for code that works - polishing cannon
balls is Greg's forte ;)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
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:C14FC748-B6F0-4352-B6C9-C06E38D0F3EA(a)microsoft.com...
> Hi,
> Just out of curiosity...
> Would it be more efficient to use .FormattedText on the range objects
> instead of .Copy and .Paste? From my test, doing so would change the
> following:
>
> iPage = .Information(wdActiveEndPageNumber)
> .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
>
> To the following:
> iPage = .Information(wdActiveEndPageNumber)
> With oListRng
> .Collapse wdCollapseEnd
> .FormattedText = oRng.FormattedText
> .Start = .End + 1
> .InsertAfter Text:=", Page " & iPage & ", Name: " & sFont & sComp & vbCr
> .HighlightColorIndex = wdAuto
> End With
> .Collapse wdCollapseEnd
>
> Thanks,
> Dave


First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4
Prev: Different results from counts ... why?
Next: save as docx from office 2003