I thought it ll be appropriate to post the complete code, so that others
benefit.
Special Thanks to MacroPod for suggesting the function Call and Private.
Thanks to Mayor to come with approriate coding for find and replace.
Thanks guys!!!.
The code goes like this:
Sub LedTool()
' If document is protected, Unprotect it.
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:=""
End If
' Set the language for the document.
Selection.WholeStory
Selection.LanguageID = wdEnglishUS
Selection.NoProofing = False
' Perform Spelling/Grammar check.
If Options.CheckGrammarWithSpelling = True Then
ActiveDocument.CheckGrammar
Else
ActiveDocument.CheckSpelling
End If
' ReProtect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, _
NoReset:=True
End If
Call Colon
Call TheBeforeAcronym
Call FindAndReplace
End Sub
Private Sub Colon()
Dim orng As Range
Dim sCase As String
With Selection
..HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(": [A-Z]", MatchWildcards:=True)
Set orng = Selection.Range
orng.Start = orng.End - 1
orng.Select
sCase = Msgbox("Word after colon should be in lower case.
Change?", vbYesNoCancel, "Change Case")
If sCase = vbCancel Then
Exit Sub
End If
If sCase = vbYes Then orng.Case = wdLowerCase
Selection.Collapse wdCollapseEnd
Loop
End With
End With
End Sub
Private Sub TheBeforeAcronym()
Dim myRange As Range
Dim orng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = "<([A-Z]{2,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set orng = myRange.Duplicate
orng.Move wdCharacter, -5
orng.MoveEnd wdCharacter, 4
If Not orng.Text = "the " Then
rslt = Msgbox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub
Private Sub FindAndReplace()
'
' FindAndReplace Macro
Dim orng As Range
Dim sRep As String
Dim sFindText As String
Dim sRepText As String
sFindText = "etc" 'the word to find
sRepText = "and so on" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "ie." 'the word to find
sRepText = "that is" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "eg" 'the word to find
sRepText = "for example" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "right click" 'the word to find
sRepText = "right-click" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "click on" 'the word to find
sRepText = "click" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "dialog" 'the word to find
sRepText = "dialog box" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "editor(s)" 'the word to find
sRepText = "editors" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "tree" 'the word to find
sRepText = "list" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "see" 'the word to find
sRepText = "refer to" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "hard disc" 'the word to find
sRepText = "hard disk" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "CD-ROM disk" 'the word to find
sRepText = "CD-ROM disc" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "datatype" 'the word to find
sRepText = "data type" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "machine" 'the word to find
sRepText = "computer" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "reboot" 'the word to find
sRepText = "restart" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "sent out" 'the word to find
sRepText = "sent" 'the word to replace
With Selection
..HomeKey wdStory
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End Sub
--
I believe in Hope.
DesigningSally
Designingsally said:
Hi Macropod
Thanks for the reply. It worked.
I wanted to know something further. When i click RUN MACRO, we usaully get a
dialog box, MACROS. In that dialog box, I can see Colon() and
TheBeforeAcronym() . Is it possible to hide word Colon() in that Run Macros
dialog box {when u run the macros}? So that user see ONLY one macros in the
Run macro dialog box.
Thanks for the help in the advance.
Sally
--
I believe in Hope.
DesigningSally
macropod said:
Hi Sally,
Simply put the line:
Call XXX
Call YYY
Call ZZZ
before the End Sub line in whichever macro you want to run first, where XXX, YYY and ZZZ are the names of the other macros, in
execution order. Then, if you want to hide the other macros from the macros dialogue box, prefix each of them with 'Private', as in
'Private Sub XXX()'.
--
Cheers
macropod
[Microsoft MVP - Word]
Designingsally said:
Hi Experts
I got 4 macro code. I desire to put it into 1 macro so that all 4 codes can
run as 1 macro.
Thanks for helping a novice.
The code is
Sub TheBeforeAcronym()
Dim myRange As Range
Dim oRng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = "<([A-Z]{2,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set oRng = myRange.Duplicate
oRng.Move wdCharacter, -5
oRng.MoveEnd wdCharacter, 4
If Not oRng.Text = "the " Then
rslt = Msgbox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub
---
Sub Colon()
Dim oRng As Range
Dim sCase As String
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(": [A-Z]", MatchWildcards:=True)
Set oRng = Selection.Range
oRng.Start = oRng.End - 1
oRng.Select
sCase = Msgbox("Word after colon should be in lower case.
Change?", vbYesNoCancel, "Change Case")
If sCase = vbCancel Then
Exit Sub
End If
If sCase = vbYes Then oRng.Case = wdLowerCase
Selection.Collapse wdCollapseEnd
Loop
End With
End With
End Sub
--
Sub FormsSpellCheck()
' If document is protected, Unprotect it.
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:=""
End If
' Set the language for the document.
Selection.WholeStory
Selection.LanguageID = wdEnglishUS
Selection.NoProofing = False
' Perform Spelling/Grammar check.
If Options.CheckGrammarWithSpelling = True Then
ActiveDocument.CheckGrammar
Else
ActiveDocument.CheckSpelling
End If
' ReProtect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, _
NoReset:=True
End If
End Sub
---
Sub FindAndReplace()
'
' FindAndReplace Macro
Dim orng As Range
Dim sRep As String
Dim sFindText As String
Dim sRepText As String
sFindText = "etc" 'the word to find
sRepText = "and so on" 'the word to replace
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
sFindText = "ie." 'the word to find
sRepText = "that is" 'the word to replace
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set orng = Selection.Range
sRep = Msgbox("Replace?", vbYesNoCancel)
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
orng.Text = sRepText
End If
Wend
End With
End With
