Look for italicized word,msgbox asks to remove,finds next italic w

P

PrincessKitty

I need a code that will look for an italicized word and highlight it and pop
up a message box asking the user if they want to remove the italics. The
user clicks yes, no, or cancel and the code highlights the next italicized
word and pops up the msgbox again. This needs to happen till it reaches the
end of the document.
This is what I have so far.

Sub Macro3()
Dim myVariable As Integer
' Macro2 Macro
' Macro recorded 11/29/2005 by ep654c
'
With Selection.Find
.Execute
.ClearFormatting
.Font.Italic = True
.Format = True
.Replacement.ClearFormatting
.Replacement.Font.Italic = False

myVariable = MsgBox("Do you want to remove italics?", vbQuestion +
vbYesNoCancel, "Remove Italics?")

If myVariable = 6 Then
.Execute Forward:=True, Replace:=wdReplaceOne, _
Format:=True, ReplaceWith:=""
ElseIf myVariable = 7 Then
.Execute Forward:=False
ElseIf myVariable = 2 Then
.Execute Forward:=False
End If
End With

End Sub

Please help. Thank you!
 
G

Greg Maxey

PK,

Why do you want a "Cancel" option?

How about:

Sub ScratchMacro()
Dim oRng As Range
Set oRng = ActiveDocument.Content
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Italic = True
.Wrap = wdFindStop
Do While .Execute
oRng.Select
If MsgBox("Do you want to remove italics", vbYesNo, "Action") = vbYes
Then
oRng.Font.Italic = False
oRng.Collapse wdCollapseEnd
Else
oRng.Collapse wdCollapseEnd
End If
Loop
End With
Selection.Collapse wdCollapseEnd
End Sub
 
G

Greg Maxey

Why do you want a "Cancel" option?

Actually that is a rather rhetorical question. You want a cancel options so
you can get out of the routine without finishing the search and modify
process. Try:

Sub ScratchMacro()
Dim oRng As Range
Set oRng = ActiveDocument.Content
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Italic = True
.Wrap = wdFindStop
Do While .Execute
oRng.Select
Select Case MsgBox("Do you want to remove italics?", vbYesNoCancel,
"Action")
Case Is = vbYes
oRng.Font.Italic = False
oRng.Collapse wdCollapseEnd
Case Is = vbYes
oRng.Collapse wdCollapseEnd
Case Is = vbCancel
Exit Do
End Select
Loop
End With
Selection.Collapse wdCollapseEnd
End Sub
 
G

Greg Maxey

Playing around with this a little more, I though I would add hightlighting
instead of selecting the text. Try:

Sub ScratchMacro()
Dim oRng As Range
Set oRng = ActiveDocument.Content
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Italic = True
.Wrap = wdFindStop
Do While .Execute
oRng.HighlightColorIndex = wdYellow
Select Case MsgBox("Do you want to remove italics from: " _
& oRng.Text, vbYesNoCancel, "Action")
Case Is = vbYes
oRng.Font.Italic = False
oRng.HighlightColorIndex = wdNoHighlight
oRng.Collapse wdCollapseEnd
Case Is = vbNo
oRng.HighlightColorIndex = wdNoHighlight
oRng.Collapse wdCollapseEnd
Case Is = vbCancel
oRng.HighlightColorIndex = wdNoHighlight
Exit Do
End Select
Loop
End With
 
P

PrincessKitty

OMG, thank you soooo much! You are a genius. This code works great!

Princesskitty
 
P

PrincessKitty

Oh, I had one more question. When the code gets to the end of the document I
want a message box to pop up and say it reached the end of the document and
would the user like to begin again from the beginning of the document. Just
in case the user started in the middle of the document or wants to double
check.

Thank you.
 
P

PrincessKitty

I just realized that this code starts from the beginning of the doc. How can
I have it start from the cursor and then have the msgbox say it reached the
end of the doc and would the user like to start the process again from the
beginning.

Thank you.
 
G

Greg

PK,

Not very elegant, but time constraints prevent me from fooling around
with it more now. (Comments on improvement, welcome from all);

Sub ScratchMacro()
Dim oRng As Range
Dim oRng1 As Range
Dim oRng2 As Range
Dim i As Long
Dim bLooped As Boolean
Set oRng1 = ActiveDocument.Content
Set oRng2 = ActiveDocument.Content
i = Selection.Start
oRng1.Start = i
oRng2.End = i
Set oRng = oRng1
bLooped = False
LoopTwo:
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Italic = True
.Wrap = wdFindStop
Do While .Execute
If bLooped = True And oRng.Start > i Then
MsgBox "Finished."
Exit Sub
End If
oRng.HighlightColorIndex = wdYellow
Select Case MsgBox("Do you want to remove italics from: " _
& oRng.Text, vbYesNoCancel, "Action")
Case Is = vbYes
oRng.Font.Italic = False
oRng.HighlightColorIndex = wdNoHighlight
oRng.Collapse wdCollapseEnd
Case Is = vbNo
oRng.HighlightColorIndex = wdNoHighlight
oRng.Collapse wdCollapseEnd
Case Is = vbCancel
oRng.HighlightColorIndex = wdNoHighlight
Exit Do
End Select
Loop
End With
If bLooped = False Then
If MsgBox("Do you want to loop to start?", _
vbYesNo, "Loop to Start") = vbYes Then
bLooped = True
Set oRng = oRng2
GoTo LoopTwo
End If
End If
End Sub
 
T

Tony Jollans

Why do you want to reinvent the wheel? You are asking for exactly what Find
and Replace does ....

Leave both Find and Replace boxes empty, put your cursor in the Find box
and press Ctrl+I, then ...

Find Next --- finds the next italicised string and highlights it (your "no")
Replace --- un-italicises the highlighted string and finds and highlight the
next (your "yes")
Close --- cancels the whole operation (your "cancel")

This process automatically starts from the cursor and, if you select Search
Down (instead of the default Search All) it will prompt at the end of the
document to see if you want to continue from the top.

Exactly what you are asking for.
 
P

Princess Kitty

Yes, I know but the company I'm contracting for wants this macro with their
own short-cut key. Let's just say there's a lot of "reinventing" going on in
this company.
 
P

Princess Kitty

Well Greg, you did it again. It works! Thank you from the bottom of my heart.

Princess Kitty
 
G

Greg

Tony,

I realized that but left it unexpressed as I figured the user wanted a
macro for some reason or another.
 
P

Princess Kitty

Hi Greg,

I was wondering if there's a code I can put in here to have the page scroll
down as it's going through the highlighted italicized word so the user can
see the word and decide if they want to keep it italicized or not.

Thank you.
 
G

Greg

Yes. Follows is an excerpt from the existing code with the necessary
line added and marked.

Do While .Execute
If bLooped = True And oRng.Start > i Then
MsgBox "Finished."
Exit Sub
End If
ActiveWindow.ScrollIntoView oRng, True 'Added This
oRng.HighlightColorIndex = wdYellow
Select Case MsgBox("Do you want to remove italics from: " _
& oRng.Text, vbYesNoCancel, "Action")
Case Is = vbYes
 
Top