Microsoft Word 2003 Visual Basic macros to remove leading, trailing, or internal whitespace

TrimLeadingWhitespace

Attribute VB_Name = "TrimLeadingWhitespace"

Public Sub MAIN()
Attribute MAIN.VB_Description = "Remove leading spaces and tabs from each line in selection or from current line if no selection.\r\n"
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.TrimLeadingWhitespace.MAIN"
Dim leaveloop
Rem TRIM ALL LEADING WHITESPACE FROM EACH LINE IN SELECTION.
Rem TO DO WHOLE FILE, SELECT ALL FIRST.
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Rem 11-24-99
Rem MODIFIED FROM TABOUT
Rem ----------------------------------------------------------------------------
Rem IF NO SELECTION, DELETE THE WHITESPACE, IF ANY, AT START OF CURRENT LINE
If Len(WordBasic.[Selection$]()) <= 1 Then
    WordBasic.StartOfLine                   'ALSO CANCELS SELECTION, IF ANY
    Rem VERY WEIRD BUG: IF LINE STARTS WITH A SINGLE SPACE AND A "(",
    Rem (SOME OTHER CHARS BESIDES "(" CAUSE SAME PROBLEM)
    Rem THEN THE MACRO HANGS UP. INSERT A DOUBLE SPACE SO THAT IF THERE
    Rem WAS ONLY A SINGLE OR NONE, IT IS NOW A DOUBLE.
    WordBasic.Insert "  "
    WordBasic.StartOfLine
    While WordBasic.[Selection$]() = Chr(9) Or WordBasic.[Selection$]() = Chr(32)
        WordBasic.WW6_EditClear
    Wend
    GoTo Bye
End If
Rem ----------------------------------------------------------------------------
Rem THERE WAS A SELECTION.  PROCESS ALL LINES IN IT.
Rem #ERROR: I THINK THIS IS WHERE SPACES ARE STILL BEING LEFT INSIDE THE TEXT:
Rem IF YOU PROCESS FROM TOP TO BOTTOM, THE LINE ENDS CHANGE,
Rem SO IT SHOULD GO FROM BOTTOM UP.  But a simple pattern-matching
Rem search may replace this anyway.

WordBasic.CopyBookmark "\Sel", "xxTabTemp"
WordBasic.SelType 1
leaveloop = 0
While WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 8 _
        Or WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 6 _
        And leaveloop <> 1
    WordBasic.StartOfLine
    Rem SEE ABOVE FOR WHY THIS IS NECESSARY
    WordBasic.Insert "  "
    WordBasic.StartOfLine
    While WordBasic.[Selection$]() = Chr(9) Or WordBasic.[Selection$]() = Chr(32)
        WordBasic.WW6_EditClear
    Wend
    WordBasic.EndOfLine
    If WordBasic.CmpBookmarks("\Sel", "\EndOfDoc") = 0 Then leaveloop = 1
    WordBasic.CharRight
Wend
WordBasic.WW7_EditGoTo "xxTabTemp"
WordBasic.EditBookmark "xxTabTemp", Delete:=1

Bye:

End Sub

TrimTrailingWhitespace

Attribute VB_Name = "TrimTrailingWhitespace"

Public Sub MAIN()
Attribute MAIN.VB_Description = "Trim all whitespace, in selection or document, that immediately precedes paragraph marks."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.TrimTrailingWhitespace.MAIN"
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Rem 11/1/00
Rem Trims all whitespace that precedes paragraph marks (thus useless),
Rem and which messes up RemoveHardCRs macro.
Rem Should be enhanced.
WordBasic.StartOfDocument
WordBasic.EditReplace Find:="^w^p", Replace:="^p", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=0
End Sub

TrimInternalWhitespace

Attribute VB_Name = "TrimInternalWhitespace"

Public Sub MAIN()
Rem COMPRESS ALL internal WHITESPACE IN THE SELECTION DOWN TO 1 SPACE.
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Rem 11-17-00, 4/26/04
Rem ----------------------------------------------------------------------------

If Len(WordBasic.[Selection$]()) <= 1 Then
    WordBasic.MsgBox "You must select a block of text before calling this macro.", "Cannot Continue", 48
    GoTo Bye
End If

Rem change all whitespace to a single space
WordBasic.EditReplace Find:="^w", Replace:=" ", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=0

Rem restore single spaces following periods to doubles
WordBasic.EditReplace Find:=". ", Replace:=".  ", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=0

Bye:

End Sub

Web this Site News

Copyright ©2008 Steven Whitney. Last modified 07/05/2008.