Results 1 to 13 of 13
  1. #1
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts

    Help with spacing/formatting macro

    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
    Attached Files Attached Files

  2. #2
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Sun Prairie, Wisconsin, Wisconsin, USA
    Posts
    2,049
    Thanks
    124
    Thanked 119 Times in 116 Posts
    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
    Charles Kyle Kenyon
    Madison, Wisconsin

  3. #3
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    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.

  4. #4
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Sun Prairie, Wisconsin, Wisconsin, USA
    Posts
    2,049
    Thanks
    124
    Thanked 119 Times in 116 Posts
    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
    Charles Kyle Kenyon
    Madison, Wisconsin

  5. #5
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Sun Prairie, Wisconsin, Wisconsin, USA
    Posts
    2,049
    Thanks
    124
    Thanked 119 Times in 116 Posts
    The sample file with the Stylesheet contains macros to copy styles.
    Charles Kyle Kenyon
    Madison, Wisconsin

  6. #6
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    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 = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
        .Replacement.Text = "\1^s\2^s\3"
        .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 = "^s\1"
        .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 = "^s\1m"
        .Execute Replace:=wdReplaceAll
        .Text = "[^s ]([ap]).m>"
        .Execute Replace:=wdReplaceAll
        'Delete spaces in # am/pm
        .Text = "([0-9])[^s ]([ap]m)"
        .Replacement.Text = "\1\2"
        .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 = "ie"
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace e.g. formatting
        .Text = "<e.g."
       .Replacement.Text = "eg"
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        'Temporarily replace etc. formatting
        .Execute Replace:=wdReplaceAll
        .Text = "<etc."
        .Replacement.Text = "etc"
        .Execute Replace:=wdReplaceAll
        .Text = "<etc>"
        .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

  7. #7
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    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
    [MS MVP - Word]

  8. #8
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    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
    Last edited by Lady-Laughsalot; 2016-11-21 at 07:58.

  9. #9
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    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

  10. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    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
    [MS MVP - Word]

  11. #11
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    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
    Attached Files Attached Files

  12. #12
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    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
    [MS MVP - Word]

  13. #13
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thank you so much for the coding, tested it over the weekend and it works. Many thanks. Shelley

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •