2 spaces to 1 space in Word 2003.

[Alan Stancliff]

I have been using a macro at work to take all double spacing after
periods, colons, etc, out of a document and replace them with double
spaces. This macro works on the entire document.

The document is broken into three sections, as defined by the menu items
INSERT>BREAK>CONTINUOUS. I have been trying to figure out how it can
be made to work this magic on only section 2.

This macro is mostly based on one I found in a Word website, and the
proper credit is given in the comment section.

Here is the macro. Any assistance would be very much appreciated.

Sub SingleSpace()
'
'<alt><ctrl><5>
' Changes 2 spaces after periods and colons
' to 1 space in conformity with our hospital
' guidelines.
' Macro modified by Alan Stancliff, based on macro
' copied from Allen Wyatt's Word Tips
'
http://wordtips.vitalnews.com/Pages/T1497_An_Automatic_Two_Spaces_After_a_Period.html
' ******************************
'
Selection.Find.ClearFormatting
'Selection.Find.ClearFormatting.Section (2)

Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run MacroName:="FixFindBox"
End Sub

Regards,

Alan Stancliff

 

[Jean-Guy Marcil]

I have been using a macro at work to take all double spacing after
periods, colons, etc, out of a document and replace them with double
spaces. This macro works on the entire document.

The document is broken into three sections, as defined by the menu items
INSERT>BREAK>CONTINUOUS. I have been trying to figure out how it can
be made to work this magic on only section 2.

This macro is mostly based on one I found in a Word website, and the
proper credit is given in the comment section.

Here is the macro. Any assistance would be very much appreciated.

Try this:

Sub SingleSpace()

Dim rgeSec2 As Range

Set rgeSec2 = ActiveDocument.Sections(2).Range

With rgeSec2.Find
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

Application.Run MacroName:="FixFindBox"

End Sub

 

[Greg Maxey]

Sub SingleSpace()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Sections(2).Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org
Word MVP web site http://word.mvps.org~~~~~~~~~~~~~~~~~~~~~~~~~~

 

[Graham Mayor]

Dim oRng As Range
On Error GoTo Oops:
Set oRng = ActiveDocument.Sections(2).Range
oRng.Select
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Exit Sub
Oops:
MsgBox "Section not found"


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Alan Stancliff]

Hello Jean-Guy, Greg, and Graham,

Thank you so much for the help. I am carefully studying your three
responses and comparing them to see what I can learn from them. So far,
I've managed to cobble together something from all three, and I have
come up with something that is quite usable.

Equally important is the opportunity to study your three approaches.

Once again, thank you for your explanations and help. Below my signature
is the code I came up with, based on your input. I referenced my sources
in the comments because some of my co-workers will be interested in
knowing how I came up with this code.

Regards,

Alan Stancliff

************CODE***************
Sub SingleSpace()
'
'<alt><ctrl><5>
' Changes 2 spaces after periods and colons
' to 1 space in conformity with CHRMC
' guidelines.
' Macro modified by Alan Stancliff, based on macro
' copied from Allen Wyatt's Word Tips
'
http://wordtips.vitalnews.com/Pages/T1497_An_Automatic_Two_Spaces_After_a_Period.html
' Extensively modified again based on suggestions from VBA newsgroup
' Suggestions made by Jean-Guy Marcel, Greg Maxey, Graham Mayer
' Message thread located at:
' news://msnews.microsoft.com:119/#[email protected]
' ******************************
'
Dim oRng As Word.Range
On Error GoTo NotEditScriptDocument:
Set oRng = ActiveDocument.Sections(2).Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Exit Sub
NotEditScriptDocument:
MsgBox "Not a standard EditScript Document"

End Sub

*************END OF CODE**************

I have been using a macro at work to take all double spacing after
periods, colons, etc, out of a document and replace them with double
spaces. This macro works on the entire document.

The document is broken into three sections, as defined by the menu items
INSERT>BREAK>CONTINUOUS. I have been trying to figure out how it can be
made to work this magic on only section 2.

This macro is mostly based on one I found in a Word website, and the
proper credit is given in the comment section.

Here is the macro. Any assistance would be very much appreciated.

Sub SingleSpace()
'
'<alt><ctrl><5>
' Changes 2 spaces after periods and colons
' to 1 space in conformity with our hospital
' guidelines.
' Macro modified by Alan Stancliff, based on macro
' copied from Allen Wyatt's Word Tips
'
http://wordtips.vitalnews.com/Pages/T1497_An_Automatic_Two_Spaces_After_a_Period.html

' ******************************
'
Selection.Find.ClearFormatting
'Selection.Find.ClearFormatting.Section (2)

Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([.\?\!\:]) {1,}"
.Replacement.Text = "\1 "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run MacroName:="FixFindBox"
End Sub

Regards,

Alan Stancliff