locked
Using macros to formulate mutiple files. RRS feed

  • Question

  • Hi,

    I have a folder of about 400 documents , and I need to apply the same formulation steps on all of them.

    Actually, I need to:

        1- Remove all empty paragraphs (^p^p) from the text,

        2- customize margins to be smaller, as: 1 cm for each , and

        3- Decrease the font size (shrink font) twice or triple for the whole text of the document.

             i.e, as we hold : Ctrl + A , then click the 'Shrink Font' button twice or triple.

    So, how can I use macros to perform that task?

    Thanks so much.

    Best regards,

    Aya.


    Aya Zoghby

    Thursday, September 6, 2012 2:16 PM

Answers

  • OK, try it this way:

    Sub ConvertFiles()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc As Document
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.txt", vbNormal)
    While strFile <> ""
      Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
        Format:=wdOpenFormatEncodedText, Encoding:=msoEncodingUTF8, _
        AddToRecentFiles:=False, Visible:=False)
      With wdDoc
        .Styles(.Paragraphs.First.Style).Font.Size = 9
        With .PageSetup
          .TopMargin = CentimetersToPoints(1)
          .LeftMargin = CentimetersToPoints(1)
          .RightMargin = CentimetersToPoints(1)
          .BottomMargin = CentimetersToPoints(1)
        End With
        .SaveAs2 FileName:=strFolder & "\" & Replace(strFile, ".txt", ".docx"), _
          Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
        With .Range.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchWildcards = False
          .Text = "^p^p"
          .Replacement.Text = "^p"
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
        End With
        .Close SaveChanges:=True
      End With
      strFile = Dir()
    Wend
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub

    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function

    Note the repeated .Execute Replace:=wdReplaceAll lines. That's just in case your have multiple sets of consecutive empty paragraphs.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by ZoghbyAya Saturday, September 8, 2012 1:09 PM
    Saturday, September 8, 2012 8:56 AM

All replies

  • hi Aya,

    Re (2):
    What are the margin sizes you want to end up with? Simply saying 1cm smaller doesn't mean much when we don't know the starting size. And which margin(s) do you want to change - top, botton, left, right?

    Re (3):
    What font size do you want to end up with? Simply saying 'shrink twice' doesn't mean much when we don't know the starting size. Also, what Style is applied to the text (eg Normal)? Changing the font size via the Style is preferable to overriding the Style with hard-formatting.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Friday, September 7, 2012 3:20 AM
    Thursday, September 6, 2012 10:12 PM
  • Hi Paul,

    As for margins I mean that I want it to be 1 cm for each of the for margins: top, bottom, right, and left.

    As for the font, it starts with 10.5, and I want it to be 9 or 8.5 with Traditional or Formal style.

    The documents that I will modify are in .docx format.

    Thanks.

    Aya.


    Aya Zoghby


    • Edited by ZoghbyAya Friday, September 7, 2012 6:31 PM
    Friday, September 7, 2012 6:28 PM
  • As for the font, it starts with 10.5, and I want it to be 9 or 8.5 with Traditional or Formal style.

    The documents that I will modify are in .docx format.

    The font can't be programmed as "9 or 8.5"; it can be progammed as 9 or it can be programmed as 8.5.

    And it can't be "with Traditional or Formal style";  it can be progammed as Traditional or it can be programmed as Formal, but only if you have styles with those names on your system. Word does not ship with a Traditional or Formal; Word's default Style is Normal.

    The following code deletes, the extra paragraph breaks, sets a 1cm margin, reduces the Normal Style's font size to 9. you can delete your existing lines that start with wdDoc.

      With wdDoc
        With .Content.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchAllWordForms = False
          .MatchSoundsLike = False
          .MatchWildcards = True
          .Text = "[^13]{2,}"
          .Replacement.Text = "^p"
          .Execute Replace:=wdReplaceAll
        End With
        .Styles("Normal").Font.Size = 9
        With .PageSetup
          .TopMargin = CentimetersToPoints(1)
          .LeftMargin = CentimetersToPoints(1)
          .RightMargin = CentimetersToPoints(1)
          .BottomMargin = CentimetersToPoints(1)
        End With
        .SaveAs2 FileName:=strFolder & "\" & Replace(strFile, ".txt", ".docx"), _
          Fileformat:=wdFormatDocument, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, September 7, 2012 10:49 PM
  •  you can delete your existing lines that start with wdDoc.

     

    With wdDoc
        With .Content.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchAllWordForms = False
          .MatchSoundsLike = False
          .MatchWildcards = True
          .Text = "[^13]{2,}"
          .Replacement.Text = "^p"
          .Execute Replace:=wdReplaceAll
        End With
        .Styles("Normal").Font.Size = 9
        With .PageSetup
          .TopMargin = CentimetersToPoints(1)
          .LeftMargin = CentimetersToPoints(1)
          .RightMargin = CentimetersToPoints(1)
          .BottomMargin = CentimetersToPoints(1)
        End With
        .SaveAs2 FileName:=strFolder & "\" & Replace(strFile, ".txt", ".docx"), _
          Fileformat:=wdFormatDocument, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With

    I could not run the macro that contains the code!!

    Moreover, I want to run it over a set of documents in a folder, as the code that you developed in:

    http://social.technet.microsoft.com/Forums/en-US/word/thread/32cb406f-36f7-4570-8a8f-860611e34da0/

    Also, what is the meaning of this sentence: " you can delete your existing lines that start with wdDoc. "?

    Thanks so much,

    Regards, Aya.


    Aya Zoghby

    Saturday, September 8, 2012 6:19 AM
  • The code I posted is for use with the code in the link!!! It's not meant to run on its own!!!

    That code has two lines starting with wdDoc. You use the new code instead of those two lines.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 6:22 AM
  • The code I posted is for use with the code in the link!!! It's not meant to run on its own!!!

    That code has two lines starting with wdDoc. You use the new code instead of those two lines.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    I am so sorry for misunderstanding.

    Just as you guided me to start a new thread for that new topic, I thought that the code will be independent on the previous topic.

    Now I applied the code , but I got the error:

    ' The Find What text contains a Pattern Match expression which is not valid.'


    Aya Zoghby

    Saturday, September 8, 2012 6:41 AM
  • That's probably due to your regional settings. Try changing:
     .Text = "[^13]{2,}"
    to:
     .Text = "[^13]{2;}"


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Saturday, September 8, 2012 6:43 AM
    Saturday, September 8, 2012 6:43 AM
  • That's probably due to your regional settings. Try changing:
     .Text = "[^13]{2,}"
    to:
     .Text = "[^13]{2;}"


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Yes, it works now.

    BUT: the only change is in the margins. The font size and empty paragraphs are not affected yet.


    Aya Zoghby

    Saturday, September 8, 2012 6:50 AM
  • Are you sure your 'empty' paragraphs are truly empty? I suspect they might have space characters or tabs. In that case, insert:
           .Text = "[ ^t]@^13"
           .Replacement.Text = "^p"
           .Execute Replace:=wdReplaceAll
    before:
           .Text = "[^13]{2;}"

    As for the font size - you need to change the Style name in:
     .Styles("Normal").Font.Size = 9
    to whatever Style name your document uses. As I said before:
    "it can't be "with Traditional or Formal style";  it can be progammed as Traditional or it can be programmed as Formal, but only if you have styles with those names on your system. Word does not ship with a Traditional or Formal; Word's default Style is Normal."


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 6:59 AM
  • I have inserted the additional code, without any changes.

    Manually, I am doing the required replacement by using the 'Replace all function' to replace all ^p^p with ^p.

    As for the document's style, how can I detect it exactly.

    In the Style partition of the Home menu, I did not find the 'Normal' style, and I can't detect what is the style of my document.

    Thanks,

    Aya.


    Aya Zoghby

    Saturday, September 8, 2012 7:11 AM
  • You should not need to replace anything manually. The Find/Replace code does it.

    To find the Style, select a paragraph, right-click on it, choose 'Styles', then see what Style name is indicated for 'Update *Style Name* to match selection'.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 8:29 AM
  • I just explain how I can get the correct result manually , i.e., before using the macro to do it automatically.

    Now the macro does not replace the empty paragraphs.

    As for the style, I think the problem is that the macro perform the modifications on a .txt files not .doc nor .docx, and finally saves the results in doc(x) files.

    So, I think that the problem of style may be solved if we start the macro by the converted to .doc(x) files.

    Am I true?

     

    Aya Zoghby

    Saturday, September 8, 2012 8:35 AM
  • OK, try it this way:

    Sub ConvertFiles()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc As Document
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.txt", vbNormal)
    While strFile <> ""
      Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
        Format:=wdOpenFormatEncodedText, Encoding:=msoEncodingUTF8, _
        AddToRecentFiles:=False, Visible:=False)
      With wdDoc
        .Styles(.Paragraphs.First.Style).Font.Size = 9
        With .PageSetup
          .TopMargin = CentimetersToPoints(1)
          .LeftMargin = CentimetersToPoints(1)
          .RightMargin = CentimetersToPoints(1)
          .BottomMargin = CentimetersToPoints(1)
        End With
        .SaveAs2 FileName:=strFolder & "\" & Replace(strFile, ".txt", ".docx"), _
          Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
        With .Range.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchWildcards = False
          .Text = "^p^p"
          .Replacement.Text = "^p"
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
          .Execute Replace:=wdReplaceAll
        End With
        .Close SaveChanges:=True
      End With
      strFile = Dir()
    Wend
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub

    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function

    Note the repeated .Execute Replace:=wdReplaceAll lines. That's just in case your have multiple sets of consecutive empty paragraphs.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by ZoghbyAya Saturday, September 8, 2012 1:09 PM
    Saturday, September 8, 2012 8:56 AM
  • The empty paragraphs now are removed, but nothing changed in the font size.

    Aya Zoghby


    • Edited by ZoghbyAya Saturday, September 8, 2012 9:26 AM
    Saturday, September 8, 2012 9:26 AM
  • I don't know what the issue is with your document's Styles. You can work around it by changing:
    .Styles(.Paragraphs.First.Style).Font.Size = 9
    to:
    .Range.Font.Size = 9

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 9:30 AM
  • Unfortunately, not working yet.

    Aya Zoghby

    Saturday, September 8, 2012 9:34 AM
  • I find that difficult to believe. Are you sure you're looking at a file that has been processed with these updates?

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 9:58 AM
  • Yes of course,

    Can I send one of these files to you to try it?


    Aya Zoghby

    Saturday, September 8, 2012 10:05 AM
  • I don't really see a lot of benefit in that - it works OK with my own txt files.

    One last try - change:
    .Styles(.Paragraphs.First.Style).Font.Size = 9
    to:
        .Range.Style = wdStyleNormal
        With .Styles(wdStyleNormal)
          .ParagraphFormat.SpaceBefore = 0
          .ParagraphFormat.SpaceAfter = 0
          .Font.Size = 9
        End With


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 10:23 AM
  • That converts the font to be Arial with size 11 !!

    Please Note that: the text is ARABIC script.

    May that modify anything.


    Aya Zoghby


    • Edited by ZoghbyAya Saturday, September 8, 2012 10:39 AM
    Saturday, September 8, 2012 10:37 AM
  • That converts the font to be Arial with size 11 !!

    I can't see how the font size would end up as 11pt - you can see clearly that the code says '.Font.Size = 9'

    Equally, the previous version of the code that said '.Range.Font.Size = 9' should also have set the font size to 9. I doubt that the content being Arabic script has anything to do with it.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 12:59 PM
  • Actually, I also can't understand how that comes,

    Anyway, thank you so much for your helpful effort.

    Best regards,

    Aya.


    Aya Zoghby

    Saturday, September 8, 2012 1:08 PM
  • I doubt that the content being Arabic script has anything to do with it.

    I have verified that the Arabic script is the problem.

    I have check the code over a mixed text that contains both Arabic and English text.

    The English text is that affected with the size modification , while the Arabic behaves unexpectedly.


    Aya Zoghby


    • Edited by ZoghbyAya Saturday, September 8, 2012 2:27 PM
    Saturday, September 8, 2012 2:26 PM
  • Dear Paul,

    How can I change the code in order to change both the font name and size,

    I will try to change the font style of the text.

    Thanks so much.

    Regards,

    Aya.


    Aya Zoghby

    Saturday, September 8, 2012 7:53 PM
  • With this code:
        .Range.Style = wdStyleNormal
        With .Styles(wdStyleNormal)
          .ParagraphFormat.SpaceBefore = 0
          .ParagraphFormat.SpaceAfter = 0
          .Font.Size = 9
        End With
    you can simply add a line for the font name:
        .Range.Style = wdStyleNormal
        With .Styles(wdStyleNormal)
          .ParagraphFormat.SpaceBefore = 0
          .ParagraphFormat.SpaceAfter = 0
          .Font.Size = 9
          .Font.Name = "SomeFont"
        End With


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, September 8, 2012 9:18 PM