Bernadette
10-09-2012, 08:15 AM
This macro works great the first time I use it but when I run it again it replaces the remainder of the document with blue text. I changed the wdFindContinue to wdFindStop and it does stop after the first use but not when the macro is run more than once. Any help is always appreciated.
Text before running macro:
[1] On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Text after running macro:
[1] (this paragraph has strikethrough) On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Text after pasting:
[2] (moved from para. [1]) On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Macro:
Sub CopyAndStrikeNew()
'
' makes selected text blue font colour (except for text that was red), adds annotation (moved from para #)
' to the beginning of selected text, copies it then does a strikethrough
Dim StrSrc As String, Rng As Range
With Selection
Set Rng = .Range
'make the selected text blue except for text that was already red
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorAutomatic
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorBlue
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop 'to replace only in the selection and not All of the document
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
.Start = .Words.First.Start
.End = .Words.Last.End
.Collapse wdCollapseStart
'inserts an annotation indicating paragraph it was taken from
StrSrc = "(moved from para. " & _
.Paragraphs(1).Range.ListFormat.ListString & ") "
.InsertBefore StrSrc 'inserts the specified text before selected text
.Font.Color = 5287936 'green colour
.Font.Bold = True
Rng.Start = .Start
Rng.Copy
.Text = vbNullString
Rng.Font.Strikethrough = True
End With
End Sub
Text before running macro:
[1] On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Text after running macro:
[1] (this paragraph has strikethrough) On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Text after pasting:
[2] (moved from para. [1]) On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. New text. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look.
Macro:
Sub CopyAndStrikeNew()
'
' makes selected text blue font colour (except for text that was red), adds annotation (moved from para #)
' to the beginning of selected text, copies it then does a strikethrough
Dim StrSrc As String, Rng As Range
With Selection
Set Rng = .Range
'make the selected text blue except for text that was already red
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorAutomatic
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorBlue
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop 'to replace only in the selection and not All of the document
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute Replace:=wdReplaceAll
End With
.Start = .Words.First.Start
.End = .Words.Last.End
.Collapse wdCollapseStart
'inserts an annotation indicating paragraph it was taken from
StrSrc = "(moved from para. " & _
.Paragraphs(1).Range.ListFormat.ListString & ") "
.InsertBefore StrSrc 'inserts the specified text before selected text
.Font.Color = 5287936 'green colour
.Font.Bold = True
Rng.Start = .Start
Rng.Copy
.Text = vbNullString
Rng.Font.Strikethrough = True
End With
End Sub