Copy all hilighted words to a new document using VBA
in [Word VBA]
|
From: andreas on 28 Dec 2009 03:23 Dear Experts: I would like to copy all hilighted words of the current document (via VBA) to a new one with the following features: 1. Highlighted word 2. Page No. where the highlighted word has been found 3. Applied Font of the highlighted word If a word has only be hilighted partially, the whole word has to be copied. Example: going (highlighted word), Page 219, Font Name: Arial Christmas (highlighted word), Page 222, Font Name: Tahoma. etc. Hope this is not asking too much and feasible, respectively. Help is much appreciated. Thank you very much in advance. Regards, Andreas
From: Graham Mayor on 28 Dec 2009 07:50 How about Dim oRng As Range Dim oSource As Document Dim oDoc As Document Dim iPage As Integer Dim sFont As String 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 .Start = .Words.First.Start .End = .Words.Last.End - 1 sFont = .Font.name iPage = .Information(wdActiveEndPageNumber) oDoc.Range.InsertAfter oRng.Text & _ ", Page " & _ iPage & ", Name: " _ & sFont & vbCr End With Loop End With End With With oDoc.Range .Paragraphs.Last.Range.Delete .Style = "Normal" 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:ab93f33f-271b-417c-b828-39e584534edf(a)m26g2000yqb.googlegroups.com... > Dear Experts: > > I would like to copy all hilighted words of the current document (via > VBA) to a new one with the following features: > > 1. Highlighted word > 2. Page No. where the highlighted word has been found > 3. Applied Font of the highlighted word > > If a word has only be hilighted partially, the whole word has to be > copied. > > Example: > > going (highlighted word), Page 219, Font Name: Arial > Christmas (highlighted word), Page 222, Font Name: Tahoma. > etc. > > > Hope this is not asking too much and feasible, respectively. > > Help is much appreciated. Thank you very much in advance. > > Regards, Andreas >
From: andreas on 28 Dec 2009 09:14 On 28 Dez., 13:50, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote: > How about > > Dim oRng As Range > Dim oSource As Document > Dim oDoc As Document > Dim iPage As Integer > Dim sFont As String > 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 > .Start = .Words.First.Start > .End = .Words.Last.End - 1 > sFont = .Font.name > iPage = .Information(wdActiveEndPageNumber) > oDoc.Range.InsertAfter oRng.Text & _ > ", Page " & _ > iPage & ", Name: " _ > & sFont & vbCr > End With > Loop > End With > End With > With oDoc.Range > .Paragraphs.Last.Range.Delete > .Style = "Normal" > End With > oDoc.Activate > > -- > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > Graham Mayor - Word MVP > > My web sitewww.gmayor.com > Word MVP web sitehttp://word.mvps.org > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > > "andreas" <andreas.her...(a)gmx.de> wrote in message > > news:ab93f33f-271b-417c-b828-39e584534edf(a)m26g2000yqb.googlegroups.com... > > > > > Dear Experts: > > > I would like to copy all hilighted words of the current document (via > > VBA) to a new one with the following features: > > > 1. Highlighted word > > 2. Page No. where the highlighted word has been found > > 3. Applied Font of the highlighted word > > > If a word has only be hilighted partially, the whole word has to be > > copied. > > > Example: > > > going (highlighted word), Page 219, Font Name: Arial > > Christmas (highlighted word), Page 222, Font Name: Tahoma. > > etc. > > > Hope this is not asking too much and feasible, respectively. > > > Help is much appreciated. Thank you very much in advance. > > > Regards, Andreas- Zitierten Text ausblenden - > > - Zitierten Text anzeigen - Hi Graham, Great coding! Thank you very much for your terrific help. It works although I would like the macro to be changed slightly. The hilighted words that have been copied into the new document should also feature the highlighting in the new document. Is that possible? This feature will allow me to check whether there are words that have only been partially highlighted. If this is feasible then it would be even more practical if in cases where partial highlighting has been applied, a statement would say so. Example: Reconstructive, Page 1, Times New Roman, partly highlighted. Surgery, Page 1, Times New Roman Hope this is not asking too much. Help is much appreciated. Thank you very much in advance. Regards, Andreas Help is much appreciated. Thank you very much in advance. Regards, Andreas
From: Graham Mayor on 28 Dec 2009 10:52 It is starting to get ugly (and slower), but the following may help 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 sFont As String Dim sComp 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 sColor = .HighlightColorIndex If .Start <> .Words.First.Start Or _ .End <> .Words.Last.End - 1 Then sComp = ", Partly highlighted" Else sComp = "" End If .Start = .Words.First.Start .End = .Words.Last.End - 1 .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 = 1 To iLen - 1 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:030f19d3-f59f-4205-a12b-6a9abfc6b1d1(a)n38g2000yqf.googlegroups.com... On 28 Dez., 13:50, "Graham Mayor" <gma...(a)REMOVETHISmvps.org> wrote: > How about > > Dim oRng As Range > Dim oSource As Document > Dim oDoc As Document > Dim iPage As Integer > Dim sFont As String > 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 > .Start = .Words.First.Start > .End = .Words.Last.End - 1 > sFont = .Font.name > iPage = .Information(wdActiveEndPageNumber) > oDoc.Range.InsertAfter oRng.Text & _ > ", Page " & _ > iPage & ", Name: " _ > & sFont & vbCr > End With > Loop > End With > End With > With oDoc.Range > .Paragraphs.Last.Range.Delete > .Style = "Normal" > End With > oDoc.Activate > > -- > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > Graham Mayor - Word MVP > > My web sitewww.gmayor.com > Word MVP web sitehttp://word.mvps.org > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > > "andreas" <andreas.her...(a)gmx.de> wrote in message > > news:ab93f33f-271b-417c-b828-39e584534edf(a)m26g2000yqb.googlegroups.com... > > > > > Dear Experts: > > > I would like to copy all hilighted words of the current document (via > > VBA) to a new one with the following features: > > > 1. Highlighted word > > 2. Page No. where the highlighted word has been found > > 3. Applied Font of the highlighted word > > > If a word has only be hilighted partially, the whole word has to be > > copied. > > > Example: > > > going (highlighted word), Page 219, Font Name: Arial > > Christmas (highlighted word), Page 222, Font Name: Tahoma. > > etc. > > > Hope this is not asking too much and feasible, respectively. > > > Help is much appreciated. Thank you very much in advance. > > > Regards, Andreas- Zitierten Text ausblenden - > > - Zitierten Text anzeigen - Hi Graham, Great coding! Thank you very much for your terrific help. It works although I would like the macro to be changed slightly. The hilighted words that have been copied into the new document should also feature the highlighting in the new document. Is that possible? This feature will allow me to check whether there are words that have only been partially highlighted. If this is feasible then it would be even more practical if in cases where partial highlighting has been applied, a statement would say so. Example: Reconstructive, Page 1, Times New Roman, partly highlighted. Surgery, Page 1, Times New Roman Hope this is not asking too much. Help is much appreciated. Thank you very much in advance. Regards, Andreas Help is much appreciated. Thank you very much in advance. Regards, Andreas
From: DaveLett on 28 Dec 2009 14:43 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
|
Next
|
Last
Pages: 1 2 3 4 Prev: Different results from counts ... why? Next: save as docx from office 2003 |