Need help with macro - trying to keep source formatting in New doc

[MC]

Would there be a way to keep format from source in this algorithm while I
copy selected highlighted text (in green) from source to a new document?

Your input is much appreciated.
Thanks!

-----------------------------------------------------------------
Sub Summarize()
Dim NewDoc As Document, MainDoc As Document, r As Range
If Documents.Count = 0 Then Exit Sub
Set MainDoc = ActiveDocument
Set NewDoc = Documents.Add
MainDoc.Activate
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
..Text = ""
..Forward = True
..Wrap = wdFindContinue
..Format = False
..Highlight = True
Do While .Execute
Set r = NewDoc.Range
r.Collapse wdCollapseEnd
Select Case Selection.Range.HighlightColorIndex

Case wdBrightGreen
r.Collapse wdCollapseEnd
r.InsertAfter Selection.Range.FormattedText
If Selection.Characters.Last.Text <> vbCr Then _
r.InsertAfter vbCr
r.ParagraphFormat.LeftIndent = 18
r.HighlightColorIndex = wdBrightGreen

End Select
Loop


End With
NewDoc.Activate

End Sub
-----------------------------------------------------------------

 

[Helmut Weber]

Hi,

see:

http://groups.google.de/group/micro...l+author:Helmut+author:Weber#7a789554588cb103

for how to get text with formatting
from one doc to another without copying anything.

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[MC]

Thank you for your kind reply. This is tremendously helpful.

Actually, if I could ask you one more question: after summarizing I would
like to specifically compact paragraphs that contain yellow highlighting. I
have a vbs script that compacts all paragraphs in general, how could I modify
it to specifically compact a certain highlight color? Thanks again for your
expert advice.

-------------------------------
Sub CompactParagraph()
'
' CompactParagraph Macro
'
'
For Each Xpara In ActiveDocument.Paragraphs

Xpara.Range.Select
Selection.Characters(Selection.Characters.Count).Delete
Selection.Characters(Selection.Characters.Count).InsertAfter (" ")

Next

End Sub

 

[Helmut Weber]

Hi MC,

so you want to remove the paragraph mark
from all paragraphs that include some
text highlighted in a certain highlight?

First, not possible at all,
if the last paragaph in the doc contains text highlighted
in that color. You can't delete the last paragraph mark,
if the paragraph contains text, whithout creating a new paragraph,
in a way. I can't explain all details here.

Second, no good idea, as such a macro
would with each run remove another paragraph mark.

You got to be more specific.
Remove highlighting as well?

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[MC]

Hi Mr Weber,

Thanks for your reply again.

Essentially, What I do is the following: as I read a text, I highlight the
titles or subtitles in a different color (i.e. green or gray) while the
paragraph under each title, I highlight it in yellow.

Currently, with the script, copied texts in the Target document end up
fragmented..each separated by paragraph marks
(or separated by Linebreaks if I read documents in columns that have been
converted from pdf).

What would really help is to have a macro (even if it means a second macro)
that can recognize copied text in the target new document that are
highlighted in yellow and specifically collapse those together (and
separated by a space) without collapsing the subtitles with them or other
sections of yellow-highlighted text that belong under other subtitles.... in
essence too, I would like to join all yellow highlighted text flanked by
green-highlighted subtitles, section by section.
Would this be possible?

I know that when the subtitles have paragraph marks after them and the body
paragraphs have linebreaks and no paragraph marks, one can specifically
delete those linebreaks... but when there are paragraph marks all over the
place instead, it becomes more of a challenge... but I suspect it might still
be possible to join text as long as there are other markers (in this case
subtitles highlighted in different colors) that flank them.

Alternative solution would be a macro that can 'replace every paragraph mark
that follow a yellow-hilighted text with a linebreak' and then a second macro
to delete linebreaks specifically. Would this be an easier approach?

Any thoughts on these two approaches?

Thanks again for your expert guidance.
cheers,
MC

 

[Helmut Weber]

Hi,

hmm... I'd prefer a third approach.
As you are speaking about titles, subtitles
and bodytext, apparingly, applying paragraph styles
would be best.
Create the three styles, and apply e.g. style "bodytext"
to every paragraph, which contains yellow highlighting, like that:

Sub Test0884a()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Highlight = True
While .Execute
rDcm.Select ' for testing
Stop ' for testing
If rDcm.HighlightColorIndex = wdYellow Then
rDcm.Style = "Bodytext"
End If
Wend
End With
End Sub

Sub Test0884b()
Dim rDcm As Range
Dim rTmp As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Style = "Bodytext"
While .Execute
rDcm.Select ' for testing
Stop ' for testing
For Each rTmp In rDcm.Characters
If rTmp.Text = Chr(11) Then
rTmp.Text = " "
End If
Next
Wend
End With
End Sub

Sub Test0884c()
' join consecutive bodytext paragraphs
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Style = "Bodytext"
While .Execute
rDcm.Select ' for testing
Stop ' for testing
If rDcm.Paragraphs(1).Next.Style = "Bodytext" Then
rDcm.Characters.Last = " "
End If
Wend
End With
End Sub

Which is far from being perfect,
but preserves the highlighting,
which some other simpler methods don't do.

Of course, all could be combined into one sub.

An error will occur, if there is no next paragraph.
There are methods to prevent that, as well.
See above: "merging cells using VB"
on how to check whether an object is nothing...

But, IMHO, you are looking for a working solution,
rather than for perfection.

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[MC]

Thanks again. That works well! I truly appreciate your help and the time spent.
Take care and have a wonderful Christmas and holiday season!
MC