Capitalized words to smallcaps on user approval

[iwonder]

Hi !



I'm using the following code (adapted from Macropod's code [thanks to him !]) to do the job on all concerned words (2 characters or more) of the document, and it works fine.

But now I'd like the user to be asked if he wants the replacement with SmallCaps or not (if not, nothing will be changed) on each capitalized word found.
Could someone help me ?
Hope my English is clear enough...

Sub ALLCAPS_TO_SMALLCAPS()
'
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][A-Z]*>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Case = wdTitleWord
    .Font.SmallCaps = True
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

I'm not a coder at all, just trying to adapt codes that I find, to my own needs.

[gmaxey]

Sub ALLCAPS_TO_SMALLCAPS()
Application.ScreenUpdating = False
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][A-Z]*>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    While .Execute
      oRng.Select
      If MsgBox("Reformat?", vbQuestion + vbYesNo) = vbYes Then
        oRng.Case = wdTitleWord
        oRng.Font.SmallCaps = True
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
Application.ScreenUpdating = True
End Sub

[iwonder]

Thanks Greg, but this asks for reformatting but dosen't show the selected word to reformat...
Something is missing i guess

Originally Posted by gmaxey

Sub ALLCAPS_TO_SMALLCAPS()
Application.ScreenUpdating = False
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][A-Z]*>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    While .Execute
      oRng.Select
      If MsgBox("Reformat?", vbQuestion + vbYesNo) = vbYes Then
        oRng.Case = wdTitleWord
        oRng.Font.SmallCaps = True
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
Application.ScreenUpdating = True
End Sub

[gmaxey]

Take out this line:
Application.ScreenUpdating = False

[iwonder]

Many thanks Greg ! That makes the difference !!!!
Thanks too for your word_tip_pages, they helped me a lot with word stuff !

Originally Posted by gmaxey

Take out this line:
Application.ScreenUpdating = False