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

    Help with macro to convert definitions in a Word 2010 document

    In my job I have to convert documents to the company's house style. One of the most time consuming jobs is converting non table definitions to table format. I have created a macro performs the following actions:

    1. Adds bold straight quotes to bold defined words
    2. Converts space after last bold quote and inserts a tab
    3. Converts auto numbering within brackets to manual numbering with a tab before the numbering and a space after the right bracket
    4. Deletes the word 'means' after the bold defined word and tab
    5. Converts full stops at the end of each paragraph to a semi-colon

    After running this macro I can then highlight all the definitions, go to Insert > Tables > convert text to table to end up with a two column table which I then format to the correct column size of C1: 2.7" and C2: 3.63" and assign 'no border'. Each subdivision of a definition is then put into the correct style (Definition Level 1 to 4 from my Change Styles pane)

    However, I cannot fathom out how to add a tab mark before a 'normal' text paragraph to be able to convert to table format in one go. I attach examples of the process. Is there also a way to convert to table format no border in the macro?

    Many thanks, Shelley

    Code:
    Sub DPU_convertdefinitions()
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        ActiveDocument.Range.ListFormat.ConvertNumbersToText
         Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = """"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "^t"
            .Replacement.Text = " "
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
       Selection.Find.Font.Bold = True
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "<*>"
            .Replacement.Text = "^034^&^034^t"
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "^034^t ^034"
            .Replacement.Text = "^032"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "^t "
            .Replacement.Text = "^t"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "^p("
            .Replacement.Text = "^p^t("
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "^tmeans"
            .Replacement.Text = "^t"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "^t "
            .Replacement.Text = "^t"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
         Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = ".^p"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    End Sub
    Attached Files Attached Files

  2. #2
    Star Lounger Graham Mayor's Avatar
    Join Date
    Mar 2016
    Location
    Cyprus
    Posts
    68
    Thanks
    0
    Thanked 24 Times in 24 Posts
    Given your sample document, call the following macro from your code

    Code:
    Sub AddTabToNormal()
    Dim oRng As Range
    Const strText As String = "^13[A-Za-z]"
        Set oRng = ActiveDocument.Range
        With oRng.Find
            Do While .Execute(FindText:=strText, MatchWildcards:=True)
                If oRng.Paragraphs(2).Style = "Normal" And _
                   oRng.Paragraphs(2).Range.Characters(1).Font.Bold = False Then
                    oRng.Paragraphs(2).Range.InsertBefore vbTab
               End If
                oRng.Collapse 0
            Loop
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

  3. #3
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Thank you Graham, I have added your coding to the bottom of my macro and it works much better, many thanks for your help. Regards, 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
  •