VBA converting manual numbering to auto numbering

Shelley Lou · #1 05-26-2021, 06:38 AM

Hi, I want to update a text to tables macro to include converting all manual numbering that starts at the beginning of a paragraph in the second column e.g. (a), (b), (i), (ii), (A), (B), (1), (2) to the correct auto numbering styles of my template: (a) Definitions Level 1; (i) Definitions Level 2; (A) Definitions Level 3; (1) Definitions Level 4. It also needs to restart numbering when it is related to a new definition. Would anybody be able to help me achieve this in my current macro? I have attached a test Word document so you can see the styles in the styles pane and how they should appear in the second column. Thanks, Shelley

Code:

Sub DPU_TextToTables()
  Dim oBorder As Border
    Selection.WholeStory
    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
    NumRows:=8, AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        With .Range
            .Font.Name = "Arial"
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 9
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpaceAtLeast
                .LineSpacing = 15
                .LineUnitBefore = 0
                .LineUnitAfter = 0
            End With
        End With
        With .Columns(1)
            .PreferredWidth = InchesToPoints(2.7)
            .Select
            With Selection.ParagraphFormat
                .Alignment = wdAlignParagraphLeft
                .LeftIndent = InchesToPoints(1)
          End With
            For Each oBorder In .Borders
            oBorder.LineStyle = wdLineStyleNone
            Next oBorder
            End With
        With .Columns(2)
            .Select
            With Selection.ParagraphFormat
                .Alignment = wdAlignParagraphJustify
            End With
            .PreferredWidth = InchesToPoints(3.63)
            For Each oBorder In .Borders
                oBorder.LineStyle = wdLineStyleNone
            Next oBorder
        End With
    End With
End Sub

macropod · #2 05-26-2021, 02:29 PM

Your document is very poorly constructed. Everything is in the Normal Style, with brute-force formatting to override it. Aside from the fact that increases the likelihood of document corruption, it makes attaining any level of formatting consistency much harder than it need be.

For an idea of the way such formatting should be done, see my post here: excel - VBA TypeText Word Wrapping inline with previous line's indentation - Stack Overflow

For some code to convert manual numbering to auto-numbering, see also: Convert outline to a multilevel list - Eileen's Lounge

Shelley Lou · #3 05-27-2021, 03:56 AM

Hi, yes you are quite right, I should have applied specific styles to the two columns. I have created a style called DefBold for Column 1 and DefText for Column 2. I have looked at the code you suggested but I can't understand it or how to apply it to my macro. How can I get the columns to change to these specific styles and possibly add them to the styles pane. The numbering levels (a), (i), (A), (1) then need to update from manual to their correct auto level. How can I do that. These definitions are converted from pdf to Word, I run one macro to do the formatting of the definitions first, check for errors then run the macro below to convert to a table.

Code:

Sub DPU_TextToTables()
  Dim oBorder As Border
    Selection.WholeStory
    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
    NumRows:=8, AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        With .Range
            .Font.Name = "Arial"
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 9
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpaceAtLeast
                .LineSpacing = 15
                .LineUnitBefore = 0
                .LineUnitAfter = 0
            End With
        End With
        With .Columns(1)
            .PreferredWidth = InchesToPoints(2.7)
            .Select
            With Selection.ParagraphFormat
                .Alignment = wdAlignParagraphLeft
                .LeftIndent = InchesToPoints(1)
                End With
            For Each oBorder In .Borders
            oBorder.LineStyle = wdLineStyleNone
            Next oBorder
            End With
        With .Columns(2)
            .Select
            With Selection.ParagraphFormat
                .Alignment = wdAlignParagraphJustify
            End With
            .PreferredWidth = InchesToPoints(3.63)
            For Each oBorder In .Borders
                oBorder.LineStyle = wdLineStyleNone
            Next oBorder
        End With
    End With
End Sub

macropod · #4 05-27-2021, 04:55 AM

Try, for example:

Code:

Sub ApplyMultiLevelHeadingNumbers()
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 5
  With LT.ListLevels(i)
    .NumberFormat = Choose(i, "%1", "(%2)", "(%3)", "(%4)", "(%5)", "(%6)")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = Choose(i, wdListNumberStyleNone, wdListNumberStyleLowercaseLetter, _
      wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _
      wdListNumberStyleArabic, wdListNumberStyleUppercaseRoman)
    .NumberPosition = 0
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(i * 0.25)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Heading " & i
  End With
  With ActiveDocument.Styles("Heading " & i)
    .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.25 - 0.25)
    .ParagraphFormat.FirstLineIndent = 0 'InchesToPoints(-0.5)
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Font.Name = "Arial"
    .Font.Italic = False
    .Font.Bold = False
    .Font.ColorIndex = wdAuto
    .Font.Size = 10
  End With
Next
End Sub

to format the Heading Styles in the document, then:

Code:

Sub ApplyHeadingStyles()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "Heading 1"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Heading 2" 'LowercaseLetter
          Case 65 To 90: .Style = "Heading 4" 'UppercaseLetter
          Case 48 To 57: .Style = "Heading 5" 'Arabic
          Case 105, 118, 120: .Style = "Heading 3" 'LowercaseRoman
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

to apply those Styles to the second column of the table.

Shelley Lou · #5 05-27-2021, 06:56 AM

Hi, the styles I need to use are Definition Level 1-4 not Heading 1-6, can I just change Heading to Definition Level and it will work for Column 2 of the Table?

Shelley Lou · #6 05-27-2021, 07:08 AM

Ok, so I've used the second macro and modified it and it seems to work great. Is there a way of getting Definition Level 1 to restart to (a) when it is a new definition, it seems to work ok for the other levels but not for Def Level 1

Code:

Sub DPU_ApplyHeadingStylesTable()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "DefText"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 1" 'LowercaseLetter
          Case 105, 118, 120: .Style = "Definition Level 2" 'LowercaseRoman
          Case 65 To 90: .Style = "Definition Level 3" 'UppercaseLetter
          Case 48 To 57: .Style = "Definition Level 4" 'Arabic
          
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Shelley Lou · #7 05-27-2021, 09:39 AM

Hi, if anyone can help, I'm looking to add a restart number after each loop. Currently only Definition Level 2-4 restarts but Definition Level 1 just carries on the alphabet. How can I get it restart back to (a) for each definition that has this type of numbering. Thanks

Code:

Sub DPU_ApplyHeadingStylesTable()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "DefText"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 1" 'LowercaseLetter
          Case 105, 118, 120: .Style = "Definition Level 2" 'LowercaseRoman
          Case 65 To 90: .Style = "Definition Level 3" 'UppercaseLetter
          Case 48 To 57: .Style = "Definition Level 4" 'Arabic
          
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

macropod · #8 05-27-2021, 03:16 PM

In order for the numbering to re-start, you need to have a Style that's part of the numbering sequence. So, starting at first principles, you'd run something like:

Code:

Sub ApplyMultiLevelDefinitionLevelNumbers()
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 5
  With LT.ListLevels(i)
    .NumberFormat = Choose(i, "%1", "(%2)", "(%3)", "(%4)", "(%5)")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = Choose(i, wdListNumberStyleNone, wdListNumberStyleLowercaseLetter, _
      wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _
      wdListNumberStyleArabic)
    .NumberPosition = 0
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(i * 0.25)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Definition Level " & i
  End With
  With ActiveDocument.Styles("Definition Level " & i)
    .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.25 - 0.25)
    .ParagraphFormat.FirstLineIndent = 0 'InchesToPoints(-0.5)
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Font.Name = "Arial"
    .Font.Italic = False
    .Font.Bold = False
    .Font.ColorIndex = wdAuto
    .Font.Size = 10
  End With
Next
End Sub

for which you need to have five Definition Level paragraph Styles.

You could then run:

Code:

Sub ApplyDefinitionLevelStyles()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "Definition Level 1"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 2" 'LowercaseLetter
          Case 65 To 90: .Style = "Definition Level 4" 'UppercaseLetter
          Case 48 To 57: .Style = "Definition Level 5" 'Arabic
          Case 105, 118, 120: .Style = "Definition Level 3" 'LowercaseRoman
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Shelley Lou · #9 05-28-2021, 01:08 AM

Just want to say a massive thank you to Paul, I now have a better understanding on the importance of styles in a document, why (a) was never restarting and I have now changed my template accordingly. I have run the second macro several times and everything appears to be working as it should, this has saved me a lot of amending time on large documents and I very much appreciate the help given on this forum.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Applying New Multi-Level List to Existing Document with Manual Numbering and Existing Styles	stanley	Word	4	12-15-2020 10:59 AM
page numbering for manual	Bursal	Word	1	07-29-2018 02:08 PM
List Numbering Set Numbering Value shows missing numbers as hidden text	lostenfeld	Word	9	01-03-2017 04:27 PM
Auto numbering macro	desireemm1	Word	1	12-10-2015 07:50 PM
auto page numbering	socomfort	Word	2	05-28-2012 04:19 PM