D
Designingsally
I m not familar with vba ppt. The logically the macros are fine but i m
gettitn some issues as my syntax is wrong i ll be glad if someone helps me
out.
I have placed 3 macros below. I ll be happy if someone turns out to help
me. thanks
Sub comments()
Dim vFindText As Variant
Dim i As Long
vFindText = Array("Because", "Also", "Since")
For i = 0 To UBound(vFindText)
With Selection
.HomeKey wdStory ' getting run time error 424 here.
With .FInd
.ClearFormatting
.Format = False
..MatchCase = True
..MatchWholeWord = True
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
Do While .Execute(findText:=vFindText(i), _
Forward:=True)
Selection.comments.Add _
Range:=Selection.Range, Text:="Please don't begin
sentences with these words."
Loop
End With
End With
Next
End Sub
Sub FindAndReplace()
'
' FindAndReplace Macro
Dim oRng As TextRange
Dim sRep As String
Dim sFindText As String
Dim sRepText As String
sFindText = "etc" 'Replace to find
sRepText = "and so on" 'Replace to replace
With Selection
..HomeKey wdStory' run time error 424 and ppt cant run in the break mode.
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = True
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set oRng = Selection.Range
sRep = MsgBox("Replace the highlighted word" & " on page " &
Selection.Information(wdActiveEndPageNumber) & " with " & Chr(34) & "and so
on" & Chr(34) & ". ", vbYesNoCancel, "Recommended Word")
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
oRng.Text = sRepText
End If
Wend
End With
End With
End Sub
Sub NoteColon()
Dim oRng As TextRange
Set oRng = ActiveDocument.Range
With oRng
With .Find ' complie error arugement not found
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute("NOTE: [A-Za-z]{1,}>", MatchWildcards:=True)
oRng.Select 'Word processing
Select Case MsgBox(Chr(34) & "Note" & Chr(34) & " on page " &
Selection.Information(wdActiveEndPageNumber) & " should not be followed by "
& Chr(34) & "colon." & Chr(34), vbYesNoCancel, "Colon")
Case vbCancel
Exit Sub
Case vbYes
oRng = Replace(oRng.Text, ":", "")
If oRng.Words.Last.Characters.First.Case <> wdUpperCase Then
oRng.Words.Last.Characters.First.Case = wdUpperCase
End If
End Select
oRng.Collapse wdCollapseEnd
Loop
End With
End With
End Sub
gettitn some issues as my syntax is wrong i ll be glad if someone helps me
out.
I have placed 3 macros below. I ll be happy if someone turns out to help
me. thanks
Sub comments()
Dim vFindText As Variant
Dim i As Long
vFindText = Array("Because", "Also", "Since")
For i = 0 To UBound(vFindText)
With Selection
.HomeKey wdStory ' getting run time error 424 here.
With .FInd
.ClearFormatting
.Format = False
..MatchCase = True
..MatchWholeWord = True
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
Do While .Execute(findText:=vFindText(i), _
Forward:=True)
Selection.comments.Add _
Range:=Selection.Range, Text:="Please don't begin
sentences with these words."
Loop
End With
End With
Next
End Sub
Sub FindAndReplace()
'
' FindAndReplace Macro
Dim oRng As TextRange
Dim sRep As String
Dim sFindText As String
Dim sRepText As String
sFindText = "etc" 'Replace to find
sRepText = "and so on" 'Replace to replace
With Selection
..HomeKey wdStory' run time error 424 and ppt cant run in the break mode.
With .Find
..ClearFormatting
..Replacement.ClearFormatting
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = True
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
While .Execute(findText:=sFindText)
Set oRng = Selection.Range
sRep = MsgBox("Replace the highlighted word" & " on page " &
Selection.Information(wdActiveEndPageNumber) & " with " & Chr(34) & "and so
on" & Chr(34) & ". ", vbYesNoCancel, "Recommended Word")
If sRep = vbCancel Then
Exit Sub
End If
If sRep = vbYes Then
oRng.Text = sRepText
End If
Wend
End With
End With
End Sub
Sub NoteColon()
Dim oRng As TextRange
Set oRng = ActiveDocument.Range
With oRng
With .Find ' complie error arugement not found
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute("NOTE: [A-Za-z]{1,}>", MatchWildcards:=True)
oRng.Select 'Word processing
Select Case MsgBox(Chr(34) & "Note" & Chr(34) & " on page " &
Selection.Information(wdActiveEndPageNumber) & " should not be followed by "
& Chr(34) & "colon." & Chr(34), vbYesNoCancel, "Colon")
Case vbCancel
Exit Sub
Case vbYes
oRng = Replace(oRng.Text, ":", "")
If oRng.Words.Last.Characters.First.Case <> wdUpperCase Then
oRng.Words.Last.Characters.First.Case = wdUpperCase
End If
End Select
oRng.Collapse wdCollapseEnd
Loop
End With
End With
End Sub