User:Widsith/wikify macro

From Wiktionary, the free dictionary
Jump to navigation Jump to search
  • 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