copy all instances of words/characters/sentences formatted withuser-defined character style to the e

[andreas]

Dear Experts:

I got a document where I would like to do the following with the help
of a macro:

- copy all occurrences of characters/words/sentences formatted with a
user-defined character style to the end of the document. Is this
possible?

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

 

[Cindy M.]

Hi Andreas,

I got a document where I would like to do the following with the help
of a macro:

- copy all occurrences of characters/words/sentences formatted with a
user-defined character style to the end of the document. Is this
possible?

Yes, it should be possible.

I'd use the Range.Find functionality to search occurrences of the
character style. And the Range.FormattedText property to "copy" the
found range to the end of the document. For the task, I'd probably set
up three range variables:

1. The original range to search
2. The range that will change during the search (when something is
Found)
3. The range at the end of the document

After each successful search, the Range used for Range.Find will change
to the Found text. So you would need to reset it before searching
again. Here's a bit of pseudocode to give you and idea:

Dim rngDocument as Word.Range = oDoc.Content
'you need an independent pointer to the range, so duplicate it
Dim rngSearch as Word.Range = rngDocument.Duplicate
Dim rngEndOfDoc as Word.Range = rngDocument.Duplicate
'The end of the document
rngEndOfDoc.Collapse(Word.WdCollapseDirection.wdCollapseEnd)

Do While rngSearch.Find.Execute('set the parameters here for the Find)
rngEndOfDoc.FormattedText = rngSearch.FormattedText
rngEndOfDoc.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
rngSearch.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
rngSearch.End = rngDocument.End
Loop

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail

 

[Helmut Weber]

Hi Andreas,

this one works for me.
I had to revert to selection,
as formattedtext didn't work for me.

Sub Test676()
Dim rDcm As Range
Dim rTmp As Range
Dim x As Long
ActiveDocument.Range.InsertAfter vbCrLf & "----------------"
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
x = rDcm.End
With rDcm.Find
.Style = "WordMVP"
While .Execute
rDcm.Copy
rDcm.start = rDcm.End
rTmp.Characters.Last.Select
Selection.Collapse
Selection.InsertBefore vbCrLf
Selection.Moveright
Selection.Paste
rDcm.End = x
Wend
End With
End Sub

The problem was avoiding to process the pasted text anew.

Sub Test676()
Dim rDcm As Range
Dim rTmp As Range
Dim x As Long
ActiveDocument.Range.InsertAfter vbCrLf & "----------------"
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
x = rDcm.End
With rDcm.Find
.Style = "WordMVP"
While .Execute
rDcm.Copy
rDcm.start = rDcm.End
rTmp.Characters.Last.Select
Selection.Collapse
Selection.InsertBefore vbCrLf
Selection.Moveright
Selection.Paste
rDcm.End = x
Wend
End With
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber

Vista Small Business, Office XP

 

[andreas]

Hi Andreas,

this one works for me.
I had to revert to selection,
as formattedtext didn't work for me.

Sub Test676()
Dim rDcm As Range
Dim rTmp As Range
Dim x As Long
ActiveDocument.Range.InsertAfter vbCrLf & "----------------"
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
x = rDcm.End
With rDcm.Find
   .Style = "WordMVP"
   While .Execute
      rDcm.Copy
      rDcm.start = rDcm.End
      rTmp.Characters.Last.Select
      Selection.Collapse
      Selection.InsertBefore vbCrLf
      Selection.Moveright
      Selection.Paste
      rDcm.End = x
   Wend
End With
End Sub

The problem was avoiding to process the pasted text anew.

Sub Test676()
Dim rDcm As Range
Dim rTmp As Range
Dim x As Long
ActiveDocument.Range.InsertAfter vbCrLf & "----------------"
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
x = rDcm.End
With rDcm.Find
   .Style = "WordMVP"
   While .Execute
      rDcm.Copy
      rDcm.start = rDcm.End
      rTmp.Characters.Last.Select
      Selection.Collapse
      Selection.InsertBefore vbCrLf
      Selection.Moveright
      Selection.Paste
      rDcm.End = x
   Wend
End With
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber

Vista Small Business, Office XP

Hey Helmut,

great job. Exactly what I wanted. Thank you so much for your
professional help. Regards; Andreas

 

[andreas]

Hi Andreas,



Yes, it should be possible.

I'd use the Range.Find functionality to search occurrences of the
character style. And the Range.FormattedText property to "copy" the
found range to the end of the document. For the task, I'd probably set
up three range variables:

1. The original range to search
2. The range that will change during the search (when something is
Found)
3. The range at the end of the document

After each successful search, the Range used for Range.Find will change
to the Found text. So you would need to reset it before searching
again. Here's a bit of pseudocode to give you and idea:

Dim rngDocument as Word.Range = oDoc.Content
'you need an independent pointer to the range, so duplicate it
Dim rngSearch as Word.Range = rngDocument.Duplicate
Dim rngEndOfDoc as Word.Range = rngDocument.Duplicate
'The end of the document
rngEndOfDoc.Collapse(Word.WdCollapseDirection.wdCollapseEnd)

Do While rngSearch.Find.Execute('set the parameters here for the Find)
    rngEndOfDoc.FormattedText = rngSearch.FormattedText
    rngEndOfDoc.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
    rngSearch.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
    rngSearch.End = rngDocument.End
Loop

Cindy Meister
INTER-Solutions, Switzerlandhttp://homepage.swissonline.ch/cindymeister(last update Jun 17 2005)http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail

Hi Cindy:

thank you for your swift and professional help, I will incorporate the
code in my rump code and let you know how things turned out. Bear with
me a couple of days. Regards, Andreas