#1
|
|||
|
|||
VBA converting manual numbering to auto numbering
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 |
#2
|
||||
|
||||
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
VBA convert manual numbering to auto numbering in table
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 |
#4
|
||||
|
||||
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 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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
VBA convert manual numbering to auto numbering in table
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?
|
#6
|
|||
|
|||
VBA convert manual numbering to auto numbering in table
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 |
#7
|
|||
|
|||
VBA convert manual numbering to auto numbering in table
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 Last edited by Shelley Lou; 05-27-2021 at 12:54 PM. Reason: Further info added |
#8
|
||||
|
||||
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 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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
VBA convert manual numbering to auto numbering in table
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 |