Help with spacing/formatting macro

Topic

New Reply

Test Defence.doc (44.5 KB)

Hi everyone, I am trying to create a macro to change paragraph/line spacing, justification etc. (as per the coding below). I have attached a document to explain what I need the macro to do. Court compliancy has recently changed and we therefore need to manually update the VF auto generated templates (these are under review). Is there a way I can reformat the document:

1. takes any underlining off;
2. deletes any two spaces to one between words;
3. adds a space after the colon for the claim number;
4. removes the hyphen after the colon on B E T W E E N;
5. converts para spacing to 0pt before and 12pt after;
6. converts line spacing to 1.5 spacing;
7. deletes any extra manual returns.

At the moment I am highlighting all of the numbered paragraphs because otherwise it deletes the tramlines. Also because I’m asking it to justify it also justifies any headings within the numbered paragraphs but I want them to remain centred. I’m just wondering if my coding could be built upon at all?

Code:

Sub DPU_VFCourt()
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
Delete extra spaces  
.Text = “[^13]{2,}”
  .Replacement.Text = “^p”
Convert paragraph spacing
  .Replacement.ParagraphFormat.SpaceBefore = 0
  .Replacement.ParagraphFormat.SpaceAfter = 12
 Convert line spacing
 .Replacement.ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
Justify text
  .Replacement.ParagraphFormat.Alignment = wdAlignParagraphJustify
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindStop
  .Execute Replace:=wdReplaceAll
End With
End Sub

Thanks
Shelley

Reply | Quote

Replies

Is there a reason why you are creating a macro to do this rather than creating a template that meets your needs with suitable styles? You are reinventing the wheel doing it with a macro.

http://www.addbalance.com/usersguide/templates.htm
http://www.addbalance.com/usersguide/styles.htm

Reply | Quote

I personally cannot change the company templates hence needing a macro to format once automated – the templates will be updated eventually but this is going to take an immense amount of time through out IT department so in the meantime we have to update manually once typed up through dictation.

Reply | Quote

OK.
You should still set up styles with much of this formatting. Use your macro to import the styles and set your formatting by using styles.

Direct formatting — formatting not based on styles — is a problem waiting to get you.

Here is information on setting up an external stylesheet you can import into a document (or template):
http://www.addbalance.com/word/stylesheet.htm

Reply | Quote

The sample file with the Stylesheet contains macros to copy styles.

Reply | Quote

Hi I have put together the coding below to help me format my Court documents in Visual Files and I just wondered if the coding could be made shorter/more simple – I’ve copied most of it from a previous macro of mine I use in DMS and have also added the remove underlining from coding I found on the internet. Many thanks. Shelley

Code:

Sub VF_FormatDocument()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range, i As Long, ArrFnd
ArrFnd = Array(“[Mm]inute”, “[Hh]our”, “[Dd]ay”, “[Ww]eek”, “[Mm]onth”, “[Yy]ear”, “Act”)
With ActiveDocument
    With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    ‘Ensure spaces within dates are non-breaking
    .Text = “()”
    .Replacement.Text = “1^s2^s3”
    .Execute Replace:=wdReplaceAll
    ‘Ensure non-breaking spaces after Mr, Mrs, Miss, Ms and Dr
    .Text = “([MD][irss]{1,3})[ ]”
    .Replacement.Text = “1^0160″
    .Execute Replace:=wdReplaceAll
    ‘Ensure spaces before numbers are non-breaking
    .Text = ” ([0-9])”
    .Replacement.Text = “^s1”
    .Execute Replace:=wdReplaceAll
    ‘Ensure spaces after numbers are non-breaking
    .Text = “([0-9]) ”
    .Replacement.Text = “1^s”
    .Execute Replace:=wdReplaceAll
    ‘Ensure spaces before numbers in the array are ordinary spaces
    For i = 0 To UBound(ArrFnd)
      .Text = “^s([0-9]{1,}^s” & ArrFnd(i) & “)”
      .Replacement.Text = ” 1″
      .Execute Replace:=wdReplaceAll
     Next
   .MatchWildcards = False
    ‘Delete white spaces before paragraph breaks
    .Text = “^w^p”
    .Replacement.Text = “^p”
    .Execute Replace:=wdReplaceAll
    ‘Delete white spaces after paragraph breaks
    .Text = “^p^w”
    .Execute Replace:=wdReplaceAll
   ‘Replace smart single quotes with straight single quotes
    .Text = “‘”
    .Replacement.Text = Chr(39)
    .Execute Replace:=wdReplaceAll
    ‘Replace smart double quotes with straight double quotes
    .Text = “”””
    .Replacement.Text = Chr(34)
    .Execute Replace:=wdReplaceAll
    ‘Delete periods in a.m./p.m.
    .MatchWildcards = True
    .Text = “[^s ]([ap]).m.”
    .Replacement.Text = “^s1m”
    .Execute Replace:=wdReplaceAll
    .Text = “[^s ]([ap]).m>”
    .Execute Replace:=wdReplaceAll
    ‘Delete spaces in # am/pm
    .Text = “([0-9])[^s ]([ap]m)”
    .Replacement.Text = “12”
    .Execute Replace:=wdReplaceAll
    ‘Delete – following a : or ;
    .Text = “([:: ;.])-”
    .Replacement.Text = “1”
    .Execute Replace:=wdReplaceAll
    ‘Replace all double + spaces with single spaces of the same kind as the first
    .Text = “([^s ])[^s ]{1,}”
    .Execute Replace:=wdReplaceAll
    ‘Replace repeated . with single .
    .Text = “[.]{2,}”
    .Replacement.Text = “.”
    .Execute Replace:=wdReplaceAll
    ‘Temporarily replace i.e. formatting
    .Text = “<i.e."
    .Replacement.Text = "i¶e¶"
    .Execute Replace:=wdReplaceAll
    .Text = "”
    .Execute Replace:=wdReplaceAll
    ‘Temporarily replace e.g. formatting
    .Text = “<e.g."
   .Replacement.Text = "e¶g¶"
    .Execute Replace:=wdReplaceAll
    .Text = "”
    ‘Temporarily replace etc. formatting
    .Execute Replace:=wdReplaceAll
    .Text = “<etc."
    .Replacement.Text = "etc¶"
    .Execute Replace:=wdReplaceAll
    .Text = "”
    .Execute Replace:=wdReplaceAll
   ‘Ensure there are two ordinary spaces following . and ?
    .Text = “([.?])[^s ]”
    .Replacement.Text = “1  ”
    .Execute Replace:=wdReplaceAll
    ‘Restore i.e., e.g. & etc. formatting
    .Text = “¶”
    .Replacement.Text = “.”
    .Execute Replace:=wdReplaceAll
    ‘Remove hyphens from e-mail
    .Text = “e-mail”
    .Replacement.Text = “email”
    .Execute Replace:=wdReplaceAll
    ‘Delete spaces before , : ; )
    .Text = “[^s ]([,:;.)])”
    .Replacement.Text = “1”
    .Execute Replace:=wdReplaceAll
    ‘Ensure ‘no.’ is followed by a non breaking space
    .Text = “no.  ”
    .Replacement.Text = “no.^s”
    .Execute Replace:=wdReplaceAll
    ‘Ensure ‘etc…’ only has one .
    .Text = “etc…”
    .Replacement.Text = “etc.”
    .Execute Replace:=wdReplaceAll
     ‘Ensure ‘etc..’ only has one .
    .Text = “etc..”
    .Replacement.Text = “etc.”
    .Execute Replace:=wdReplaceAll
   End With
Selection.Find.ClearFormatting
Selection.Find.Font.Underline = wdUnderlineSingle
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = False
With Selection.Find
.Text = “”
.Replacement.Text = “”
.Replacement.Font.Underline = wdUnderlineNone
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With
End Sub

Reply | Quote

A lot of that looks like code I’ve provided in the past. Other than:

Code:

   End With
Selection.Find.ClearFormatting
Selection.Find.Font.Underline = wdUnderlineSingle
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = False
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Replacement.Font.Underline = wdUnderlineNone
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

there’s not much clean-up/simplification to be done. To be sure, the code could be made more compact via the use of arrays, but that would also make it much harder to maintain. The code above could be reduced to:

Code:

    'Remove italics and underlining from underlined text
    .Format = True
    .Font.Underline = wdUnderlineSingle
    .Text = ""
    .Replacement.Text = ""
    .Replacement.Font.Underline = wdUnderlineNone
    .Replacement.Font.Italic = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
  End With

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Hi Macropod, yes you have been very kind in sorting out code in a previous macro which I’ve copied certain bits to this one. I’ve inserted your new code and I’ve now got it to work. Many thanks. Shelley

Reply | Quote

Hi, is there are way to add to the code below that the command ignores/skips any paragraph marks in a table, paragraph marks within tramlines (I think that is what they are called) and ignore/skip any paragraph marks formatted bold. The idea is that I use this macro on automated documents where the original templates haven’t yet been reformatted by our IT department. I want to perhaps add this code to the coding in the post above if possible without having to select text first. Thanks. Shelley

Code:

Sub DPU_DeleteExtraParaSpaces_DMS()
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = “[^13]{2,}”
  .Replacement.Text = “^p”
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
End Sub

Reply | Quote

That would required a different approach. Before it could be implemented, however, you’ll need to clarify what you mean by ‘tramlines’.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Hi Macropod – thank you for your reply, I’ve been working on the macro as per the coding below and have attached a few documents by way of examples – the first doc (Test Defence) is how our Court docs are generated through VF, we then start typing up the dictation (see doc named Before Macro Run Test Doc) which brings in loads of paragraph marks, the third doc (After Macro Run) is how the macro works and as you can see it takes out the two lines above and below the word DEFENCE on the first page which should not be removed, it does however leave anything in tables alone. I’ve tried Charles’ method by creating a template to generate the styles but because the paragraph marks are in the normal style it changes the whole doc to 0pt before 12pt after with 1.5 spacing throughout which I don’t want it to do, I just want it to clean up the text I’ve typed taking out all the para marks (although at the moment it doesn’t remove them from before the tables on the second page) but without having to select that text first. Is there a way of the code skipping the paragraph marks between the two lines and removing all unnecessary para marks? Shelley

Code:

Sub DPU_VFCourt()
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = “[^13]{2,}”
  .Replacement.Text = “^p”
  .Replacement.ParagraphFormat.SpaceBefore = 0
  .Replacement.ParagraphFormat.SpaceAfter = 12
  .Replacement.ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
  .Replacement.ParagraphFormat.Alignment = wdAlignParagraphJustify
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
End Sub

Reply | Quote

Doing the cleanup you want isn’t going to be straightforward when you want a macro that:

ignores/skips any paragraph marks in a table, paragraph marks within tramlines

and multiple consecutive empty paragraphs are formatted as bold and/or underlined. That aside, wildcard Finds for paragraph breaks preceding tables is itself problematic. Give the following macro a try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, t As Long
With ActiveDocument
  t = .Tables.Count
  If t = 0 Then
    Call ProcessRange(.Range)
  Else
    Call ProcessRange(.Range(0, .Tables(1).Range.Start))
    For i = 2 To t
      Call ProcessRange(.Range(.Tables(i - 1).Range.End, .Tables(i).Range.Start))
      If .Tables(i).Range.Start - .Tables(i - 1).Range.End = 2 Then
        .Tables(i).Range.Characters.First.Previous.Delete
      End If
    Next
    Call ProcessRange(.Range(.Tables(t).Range.End, .Range.End))
  End If
End With
Application.ScreenUpdating = True
End Sub

Sub ProcessRange(Rng As Range)
Dim i As Long
For i = 1 To 5
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2}"
    .Replacement.Text = "^p"
    .Format = True
    .Font.Bold = False
    .Font.Underline = False
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Forward = True
    .Execute Replace:=wdReplaceAll
    If .Found = False Then Exit For
  End With
Next
End Sub

You’ll see the called sub has a loop. I’ve given it an arbitrary upper limit of 2 iterations to clear out pairs of empty paragraphs. That’s because a wildcard Find expression like .Text = “[^13]{2,}” won’t find any empty paragraphs before a table. Using up to 5 iterations of .Text = “[^13]{2}” is sufficient to overcome that except that, even then, a pair of empty paragraphs before a table may remain. I’ve coded the macro to delete one such empty paragraph between tables.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Hi Macropod, thank you so much for the coding, tested it over the weekend and it works. Many thanks. Shelley

Reply | Quote

Hi Macro – I have been using the macro below and it works really well on documents with spaces but not on documents with no spaces (I have attached two documents as examples) – how can I get it to work on documents with no spaces also and also to remove any underlining. Thanks. Shelley

Code:

Sub VFCourtSpaces()
Application.ScreenUpdating = False
Dim i As Long, t As Long
With ActiveDocument
  t = .Tables.Count
  If t = 0 Then
    Call ProcessRange(.Range)
  Else
    Call ProcessRange(.Range(0, .Tables(1).Range.Start))
    For i = 2 To t
      Call ProcessRange(.Range(.Tables(i – 1).Range.End, .Tables(i).Range.Start))
      If .Tables(i).Range.Start – .Tables(i – 1).Range.End = 2 Then
        .Tables(i).Range.Characters.First.Previous.Delete
      End If
    Next
    Call ProcessRange(.Range(.Tables(t).Range.End, .Range.End))
  End If
End With
Application.ScreenUpdating = True
End Sub

Sub ProcessRange(Rng As Range)
Dim i As Long
For i = 1 To 5
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = “[^13]{2}”
    .Replacement.Text = “^p”
    .Replacement.ParagraphFormat.SpaceBefore = 0
  .Replacement.ParagraphFormat.SpaceAfter = 12
  .Replacement.ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
  .Replacement.ParagraphFormat.Alignment = wdAlignParagraphJustify
    .Format = True
    .Font.Bold = False
    .Font.Underline = False
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Forward = True
    .Execute Replace:=wdReplaceAll
    If .Found = False Then Exit For
  End With
Next
End Sub

Reply | Quote

I don’t know what you mean by ‘documents with spaces’ vs ‘documents with no spaces’. The macro is designed to remove unwanted spacing under certain conditions, I can’t see how whatever you mean by ‘no spaces’ comes into that.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Hi Macropod – the macro works in the first document that has paragraph marks to be deleted i.e. in the body of the text numbered 1-9 where there are paragraph marks the macro removes these and also changes the paragraph spacing to 0pt before and 12pt after with line spacing of 1.5 but in the second document where there are no spaces between numbers 1-9 the macro doesn’t change the paragraph/line spacing so I’m missing code to be able to do this and remove any underlining also. Thanks. Shelley

Reply | Quote

OK, but that’s only because you’ve changed the code I supplied – which had no effect on paragraph formatting. Since the additional code to do that is inside a loop that only comes into play when the specified content is found, it can’t be expected to do anything when that content isn’t found. Moreover, that kind of reformatting should be managed via Style redefinition, not by overriding Styles with hard formatting. Then it wouldn’t depend on anything being found/not found. It would, of course, require Styles to be used properly – which your attachments don’t do.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote