#1
|
|||
|
|||
VBA Change to correct Heading style
I have a macro that converts manual numbering to auto Heading styles but this only works for digits. Would it be possible to create code that converts manual (a), (i), (A), (1) at the beginning of paragraphs of unformatted text to a Heading style.
The macro would run on selected text only then first find instances of (a) and an InputBox would ask what Heading style it should be and then change to what is selected, same goes for (i), (A), (1). It would also need to include variations, for instance, a. or i. etc. Would this be possible? level 3 and 4 numbering and body.docx |
#2
|
||||
|
||||
Does this easier, non-specific version go close enough? It appears to work quite well on your sample doc. I think for it to work best, your selection should begin with a Heading 1 so the autoformat can work out the correct hierarchy.
Code:
Sub Reformatter() With Options .AutoFormatApplyHeadings = True .AutoFormatApplyLists = True .AutoFormatApplyBulletedLists = True .AutoFormatApplyOtherParas = True .AutoFormatReplaceQuotes = True .AutoFormatReplaceSymbols = True .AutoFormatReplaceOrdinals = True .AutoFormatReplaceFractions = True .AutoFormatReplacePlainTextEmphasis = True .AutoFormatReplaceHyperlinks = True .AutoFormatPreserveStyles = True .AutoFormatPlainTextWordMail = True End With Selection.Document.Kind = wdDocumentNotSpecified Selection.Range.AutoFormat WordBasic.ToolsBulletsNumbers Replace:=0, Type:=1, Remove:=1 End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
VBA Change to correct Heading style
Hi, many thanks for taking the time to reply with your code, unfortunately the code didn't work for me on the same sample document, it just removed (a), (b) etc. to non-numbered paragraphs (see image) instead of converting (a), (b) to Heading 3 which we have set up as 1.1.1 then (i), (ii) becomes Heading 4 which we have as 1.1.1.1 etc.
Bit stumped on this one. Image.PNG |
#4
|
||||
|
||||
Did those paragraphs get a style applied to them? I expect they became 'List" so you need to modify the style settings for that style to get autonumbering on it again. It is not ideal to apply an a,b,c list as Heading 3 because that removes your ability to apply a real third level heading with 1.3.1, 1.3.2 etc
The purpose of the macro is to get consistent styles applied across your selection and then, if required, it is easier for a second macro to reassign a style (like convert 'List' paragraphs to 'Heading 3')
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
||||
|
||||
You might find the code I posted in the following link useful. It shows in two posts how to create list-numbering systems attached to Heading Styles and convert manual numbering to auto-numbering using those Styles.
Convert outline to a multilevel list - Eileen's Lounge
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, many thanks for your response. I do actually use one of your macros for converting manual numbering to Heading numbering which works really well for the digits part.
The only problem with creating a List is that not all converted documents are the same, so for instance, the format might be 1., 1.1, 1.1.1, (a), (i) etc. so (a) might actually be Heading 4 and not Heading 3 – there are probably too many variations to create one macro I am suspecting. I thought perhaps a series of If Else might do the trick e.g. If .Characters.First <> "([a-z]) Then MsgBox Do you want to update the style to Heading 3 yes/no if no select a Heading style update all yes/no But I'm really not sure. |
#7
|
||||
|
||||
Quote:
For what you now seem to require, you'd use different variants of the macros for whichever numbering schemes your source documents employ. Simply examine the document to determine numbering scheme, then run the macros applicable to that scheme. Thus, (per the Eileen's Lounge macros) you might have macros named: ApplyMultiLevelHeadingNumbersA ApplyMultiLevelHeadingNumbersB ApplyMultiLevelHeadingNumbersC and ApplyHeadingStylesA ApplyHeadingStylesB ApplyHeadingStylesC So, if (a) is Heading 3 in one document and Heading 4 in another, you'd simply choose the variants that fit the Heading 3 or Heading 4 scenario, as appropriate. And, to further automate things, you might insert a line like: Call ApplyHeadingStylesA just before the 'End Sub' of the ApplyMultiLevelHeadingNumbersA macro, and so on.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, yes I use that code you did for me every day for converting definitions to our house style, couldn't be without it now it saves so much time.
I did try to copy that code and adapt it for what I require now but couldn't work out how to convert the manual (a), (b) etc. to our house style so (a), (b) may become 1.1.1 or even 1.1.1.1 - the source documents are converted from pdf as unformatted text then I have to convert to our house style - the numbering styles in the source documents can vary a lot and very rarely match our house style numbering. I actually use one of your VBA codes I found online for house styling the numbering in documents which again is such a time saver. Code:
Sub ManualToAutoHeading_ExcTables() Application.ScreenUpdating = False Dim Para As Paragraph, nextPara As Paragraph, rng As Range, iLvl As Long, n As Long, StyleName As String, wrd As Long, Count As Long Dim i As Integer Selection.Range.Style = "Body Text" If Selection.Type = wdSelectionIP Then MsgBox Prompt:="You have not selected any text!" Exit Sub End If With Selection.Range Set rng = Selection.Range With rng For Each Para In .Paragraphs 'Remove all leading spaces e.g tabs, spaces, NBS For n = 1 To Para.Range.Characters.Count If Para.Range.Characters(1).text = " " Or Para.Range.Characters(1).text = " " Or Para.Range.Characters(1).text = Chr(9) Or Para.Range.Characters(1).text = Chr(160) Then Para.Range.Characters(1).Delete Else: Exit For End If Next n Next For Each Para In .Paragraphs If Para.Range.Information(wdWithInTable) = False Then Set rng = Para.Range.Words.First 'Convert manual numbering to Heading numbering With rng If IsNumeric(.text) Then While .Characters.Last.Next.text Like "[0-9. " & vbTab & "]" .End = .End + 1 Wend iLvl = UBound(Split(.text, ".")) If IsNumeric(Split(.text, ".")(UBound(Split(.text, ".")))) Then iLvl = iLvl + 1 If iLvl < 10 Then .text = vbNullString Para.Style = "Heading " & iLvl End If End If End With End If Next End With Application.ScreenUpdating = True End With End Sub |
#9
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod - So I've been working on the code you have previous supplied and have adapted this to be 1., 1.1, (a), (i), (A), (1) - I can't seem to figure out how to remove the bold from the actual number and also how to move Heading 2 back to the margin in alignment with Heading 1.
TEST.docx Code:
Sub ApplyMultiLevelHeadingNumbers_B() Application.ScreenUpdating = False Dim LT As ListTemplate, i As Long Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True) For i = 1 To 6 With LT.ListLevels(i) .NumberFormat = Choose(i, "%1.", "%1.%2", "(%3)", "(%4)", "(%5)", "(%6)") .TrailingCharacter = wdTrailingTab .NumberStyle = Choose(i, wdListNumberStyleArabic, wdListNumberStyleArabic, _ wdListNumberStyleLowercaseLetter, wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _ wdListNumberStyleArabic) .NumberPosition = 0 .Alignment = wdListLevelAlignLeft .TextPosition = InchesToPoints(i * 0.5) .ResetOnHigher = True .StartAt = 1 .LinkedStyle = "Heading " & i End With With ActiveDocument.Styles("Heading " & i) .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.5 - 0.5) .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 Application.ScreenUpdating = True End Sub When I run the other macro to update the manual numbering to auto it debugs at If bLvl = False Then Undo and the error Sub or Function not defined. I've googled this and changed the sub name but it still debugs and not sure what to do. Code:
Sub ApplyHeadingStyles_Auto() Dim Para As Paragraph, Rng As Range, i As Long, StrTxt As String, bLvl As Boolean Dim objUndo As UndoRecord: Set objUndo = Application.UndoRecord With ActiveDocument.Range For Each Para In .Paragraphs With Para StrTxt = Trim(.Range.Words.First.text): bLvl = False objUndo.StartCustomRecord ("Fmt") For i = 1 To 6 .Style = "Heading " & i If .Range.ListFormat.ListString = StrTxt Then .Range.Words.First.text = vbNullString bLvl = True: Exit For End If Next objUndo.EndCustomRecord If bLvl = False Then Undo End With Next End With End Sub |
#10
|
||||
|
||||
How is it that you have two Heading 2 formats?
To remove the bold attribute from all except the first two heading levels, all you need do is insert: .Font.Bold = Choose(i, 1, 1, 0, 0, 0, 0) after, say,: .NumberPosition = 0 For the indents, replace: .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.5 - 0.5) with: Code:
Select Case i Case 1, 2 .ParagraphFormat.LeftIndent = 0 Case Else .ParagraphFormat.LeftIndent = InchesToPoints((i - 2) * 0.5) End Select Code:
Sub ApplyHeadingStyles_Auto() Dim Para As Paragraph, Rng As Range, i As Long, StrTxt As String, bLvl As Boolean Dim objUndo As UndoRecord: Set objUndo = Application.UndoRecord With ActiveDocument.Range For Each Para In .Paragraphs With Para Set Rng = .Range With Rng .Collapse wdCollapseStart .MoveEndUntil vbTab, wdForward StrTxt = .Text: bLvl = False .End = .End + 1 End With objUndo.StartCustomRecord ("Fmt") For i = 1 To 6 .Style = "Heading " & i If .Range.ListFormat.ListString = StrTxt Then Rng.Text = vbNullString bLvl = True: Exit For End If Next objUndo.EndCustomRecord If bLvl = False Then ActiveDocument.Undo End With Next End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, thank you so much for the update. I still can't seem to get the second macro 'ApplyHeadingStyles_Auto' to work - it has a compile error Sub or Function not defined and highlights the word 'Undo' in the line If bLvl = False Then Undo - should I have a particular Sub or Function in a module to get this to work?
I have modified the first macro slightly to get it to work. The line .Font.Bold = Choose(i, 1, 1, 0, 0, 0, 0) was still making the heading number bold so I changed this to .Font.Bold = Choose(i, 0, 0, 0, 0, 0, 0) and that seems to have worked. I also needed the paragraphs to have Hanging Indents. I recorded the steps first to get the values .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) so after trying many variations I've come up with this code which seems to work. Code:
With ActiveDocument.Styles("Heading " & i) Select Case i Case 1, 2 .ParagraphFormat.LeftIndent = InchesToPoints(0.5) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) Case 3 .ParagraphFormat.LeftIndent = InchesToPoints(1) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) Case 4 .ParagraphFormat.LeftIndent = InchesToPoints(1.5) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) Case 5 .ParagraphFormat.LeftIndent = InchesToPoints(2) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) Case 6 .ParagraphFormat.LeftIndent = InchesToPoints(2.5) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) End Select |
#12
|
||||
|
||||
Quote:
Quote:
.Font.Bold = False Quote:
.ParagraphFormat.FirstLineIndent = 0 'InchesToPoints(-0.5) (which was in the code you posted), to: .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) And change: Code:
Select Case i Case 1, 2 .ParagraphFormat.LeftIndent = 0 Case Else .ParagraphFormat.LeftIndent = InchesToPoints((i - 2) * 0.5) End Select Code:
Select Case i Case 1, 2 .ParagraphFormat.LeftIndent = InchesToPoints(0.5) Case Else .ParagraphFormat.LeftIndent = InchesToPoints((i - 1) * 0.5) End Select
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod thank you for the updated code for the second macro, I've now got that working. I am now working on a few variations of the Apply Multilevel Heading Numbers code as you have suggested for different converted source document numbering.
I have named the second code that converts manual numbering ApplyHeadingStyles_IfManual and your other code from Eileen's Lounge if auto numbering ApplyHeadingStyles_IfAuto. I'm just wondering how I can add both Calls to each Apply Multilevel so if the code detects manual run Call ApplyHeadingStyles_IfManual or if it detects auto to run ApplyHeadingStyles_IfAuto - is there a way to do that or am I just complicating things? |
#14
|
||||
|
||||
You could just call both. It might work best if you call the auto-numbering macro first.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, I'm currently testing it on a large document and have added a call to the end of the apply multilevel then the auto one to the end of the manual one.
I've come across an issue I'm trying to solve in that if the manual numbering or manual (a), (i) etc. is not followed by a tab (e.g its a space) the ApplyHeadingStyles code stops auto numbering at that point. Capture.PNG |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word 2007: Unable to change character style, when using a linked Char/Para style format | Last Chance | Word | 3 | 06-09-2021 12:52 PM |
Using numbered list style, how to indent text immediately following heading to match heading indent? | SpechtacularDave | Word | 3 | 09-25-2019 01:22 PM |
Heading not following the correct numbering | jongleur | Word | 2 | 05-16-2017 10:52 AM |
Tab character causes style change to Heading 4 after macro | Jennifer Murphy | Word VBA | 2 | 12-14-2015 02:31 AM |
Unable to correct auto number of heading 5 | KieranWood | Word | 2 | 03-03-2011 09:28 AM |