Visual Basic – odstranění přebytečných mezer

Makro pro Word 2007

Zde je makro pro Word 2007, které automaticky odstraní vícenásobné mezery v textu. Makro jsem vytvořila úpravou nahraného makra. Aby makro odstraňovalo i více jak dvojnásobné mezery, bylo nutno přidat, kromě obyčejného vyhledání a nahrazení, ještě smyčku While. Určitě to není nejúspornější kód, ale jde mi zde zatím pouze o funkčnost. Toto by šlo řešit i přes regulární výrazy…

Pro obyčejný text lze využít též nástroje pro webdesignery, které přebytečné mezery či bílé znaky odstraní po zadání textu do formuláře. Zde jsou dva nástroje: "Remove Spaces from Text - MiniWebtool" či "Delete All Whitespace Characters".

Makro ve Wordu bude vhodné převážně pro běžné uživatelé, kteří mají text naformátovatý ve Wordu. Můžete si ho zkopírovat a používat. Použití je na vlastní nebezpečí!

Zdrojový kód

Sub Makro_JV_Odstraneni_duplikatnich_mezer()
'
' Makro odstraní všechny vicenasobne mezery v celem textu. Nahradi je jedinou mezerou.
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    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
    ' opakovani nahrazovani pro pripad vicenasobnych mezer
    Do While Selection.Find.Found = True
        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
    Loop
End Sub