User:Widsith/wikify macro


 * courtesy of SemperBlotto

Sub Wikify ' ' Wikify Macro ' Wikify text by removing strange characters and putting double square brackets around words '   Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting ' ' Remove punctuation marks '   Punct = ".,;:?!%=/\[]" For I = 1 To 14 With Selection.Find .Text = Mid(Punct, I, 1) .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next I   For I = 0 To 9 With Selection.Find .Text = I       .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next I   With Selection.Find .Text = """" .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = True .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' ' Replace double spaces with single (cheap and nasty method) '   For I = 1 To 5 With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next I ' ' Put wikifying brackets each side of the spaces '   With Selection.Find .Text = " " .Replacement.Text = "]] [[" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' ' Put wikifying brackets each side of a new line '   With Selection.Find .Text = vbCr .Replacement.Text = "]] [[" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' ' Replace a range of Italian words that they string together '   Dim It(5) As String It(1) = "d'"   It(2) = "[[dall'"    It(3) = "[[dell'"    It(4) = "[[l'"    It(5) = "[[nell'"    For I = 1 To 5    With Selection.Find        .Text = It(I)        .Replacement.Text = "[["        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Selection.Find.Execute Replace:=wdReplaceAll    Next I ' ' Put wikifying brackets at the end and beginning of the text '    Selection.WholeStory    Selection.Range.Case = wdLowerCase    Selection.EndKey Unit:=wdStory    Selection.TypeText Text:=""    Selection.HomeKey Unit:=wdStory    Selection.TypeText Text:="" ' ' Remove any null entries '    With Selection.Find        .Text = "[["        .Replacement.Text = ""        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub