#16
|
||||
|
||||
Try:
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 " ", wdForward If InStr(.Text, vbTab) > 0 Then .Collapse wdCollapseStart .MoveEndUntil vbtab, wdForward End If 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] |
#17
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, thank you for the updated code. I've run it on my test document this morning. I've attached a before and after document. The code runs ok for clauses 1 and 2 (although at clause 1 the word DEFINITIONS should be bold), then stops at clause 3.1, picks up again for sub levels at 3.4.1, then stops, picks up at clause 4 to 4.1, then stops, all of clause 5 is updated then stops at clause 6 for the rest of the document. Do you think it might be something to do with the unnumbered paragraphs causing the issue - I've checked to make sure all the manual numbering have periods in case that was the issue but they all seem to be there.
BEFORE doc.docx AFTER doc.docx |
#18
|
|||
|
|||
VBA Change to correct Heading style
After much testing I have discovered where the issue is - sometimes when converting docs from pdf then pasting as unformatted text the sequence of the numbering may not always follow on correctly and as the code is looking for the next number sequence this is where the code kept stopping and starting.
I will have to put together another macro to check the unformatted text first as another problem that may occur is if the manual numbering contains commas or spaces etc. instead of periods. |
#19
|
||||
|
||||
You are correct about that. Below is a revised version of the macro. Although it can't address that particular problem, it should run more efficiently.
Where you find that the macro hasn't processed all content, you can correct the document error at whatever point that was (e.g. by temporarily inserting a paragraph with the missing numbering) , then run the macro again and have it automatically resume processing from that point. Your document, for example, has a missing paragraph break, such that two numbered paragraphs have been joined, thus breaking the numbering sequence. Of course, if you insert temporary paragraphs, you will then have the question of what to do about them once the processing has finished. If you delete them, the auto-numbering will auto-update but, if you don't want that, about your only recourse would be to mark them as hidden or include a note as to why they're there. It all depends on how important it might be to preserve the original numbering. Code:
Sub ApplyHeadingStyles_Auto() Application.ScreenUpdating = False 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.Characters.First With Rng If .Text Like "[0-9(]" Then .MoveEndUntil " ", wdForward If InStr(.Text, vbTab) > 0 Then .Collapse wdCollapseStart .MoveEndUntil vbTab, wdForward End If StrTxt = .Text: bLvl = False .End = .End + 1 objUndo.StartCustomRecord ("Fmt") For i = 1 To 6 .Style = "Heading " & i If .ListFormat.ListString = StrTxt Then .Text = vbNullString: bLvl = True: Exit For End If Next objUndo.EndCustomRecord If bLvl = False Then ActiveDocument.Undo: DoEvents End If End With End With Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#20
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod thank you so much for your help with this. I have since copied the code for the Heading numbering so I can do the same thing with my schedule numbering.
I have changed any reference of Heading in the code to Schedule Level and it works well for ApplyMultiLevelNumbers_A and ApplyMultiLevelNumbers_B but for some reason I am getting a run time error 5167 This is not a valid style name in the code below at the line .LinkedStyle = "Schedule Level " & i - when I click the Reset icon in the VBA window the styles update as they should so I am not sure why this bug is happening - I have checked the spelling, spaces etc and even copied the line from ApplyMultiLevelNumbers_A as that code is working just fine with no errors - do you have any ideas why this would happen? Code:
Sub ApplyMultiLevelScheduleNumbers_HouseStyle() 'Add as a call to ApplyScheduleStyles_IfAuto to convert numbering to house style Application.ScreenUpdating = False Dim LT As ListTemplate, i As Long Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True) For i = 1 To 8 With LT.ListLevels(i) .NumberFormat = Choose(i, "%1.", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "(%5)", "(%6)", "(%7)", "(%8)") .TrailingCharacter = wdTrailingTab .NumberStyle = Choose(i, wdListNumberStyleArabic, wdListNumberStyleArabic, wdListNumberStyleArabic, _ wdListNumberStyleArabic, wdListNumberStyleLowercaseLetter, wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _ wdListNumberStyleArabic) .NumberPosition = 0 .Font.Bold = Choose(i, 0, 0, 0, 0, 0, 0, 0, 0) .Alignment = wdListLevelAlignLeft .TextPosition = InchesToPoints(i * 0.5) .ResetOnHigher = True .StartAt = 1 .LinkedStyle = "Schedule Level " & i End With With ActiveDocument.Styles("Schedule Level " & i) Select Case i Case 1 .ParagraphFormat.LeftIndent = InchesToPoints(0.5) Case 2 .ParagraphFormat.LeftIndent = InchesToPoints(1) Case 3 .ParagraphFormat.LeftIndent = InchesToPoints(1.5) Case 5 .ParagraphFormat.LeftIndent = InchesToPoints(2.75) Case 6 .ParagraphFormat.LeftIndent = InchesToPoints(3.25) Case 7 .ParagraphFormat.LeftIndent = InchesToPoints(3.75) End Select .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) Select Case i Case 4 .ParagraphFormat.LeftIndent = InchesToPoints(2.25) .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.75) End Select .ParagraphFormat.Alignment = wdAlignParagraphJustify .Font.Name = "Arial" .Font.Italic = False .Font.ColorIndex = wdAuto .Font.Size = 10 End With Next Application.ScreenUpdating = True End Sub |
#21
|
||||
|
||||
What is the value of i when you get the error message? Do you have a Schedule Level Style with that value?
PS: you seem to have overlooked my previous advice about changing: .Font.Bold = Choose(i, 0, 0, 0, 0, 0, 0, 0, 0) to: .Font.Bold = False Your left indents could also be handled more simply, via: .ParagraphFormat.LeftIndent = InchesToPoints(Choose(i, 0.5, 1, 1.5, 2.25, 2.75, 3.25, 3.75)) Likewise, the varying first line indents could be handled via: .ParagraphFormat.FirstLineIndent = -InchesToPoints(Choose(i, 0.5, 0.5, 0.5, 0.75, 0.5, 0.5, 0.5))
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#22
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, many thanks for your reply - I found out why it was creating a bug for the style - I had not created a new Schedule Level 8 style which I've now done and the code is working. I have noticed though that in the Define new Multilevel List dialog box all the styles are set to Aligned at: 0" but in the Style Pane they show the correct indent for each style - do I need to add something to the code for the Define new Multilevel List Aligned at: to update also?
Apologies for missing the .Font.Bold = False line which I've now added to the Schedule Level codes but this did not work in my Heading code, it removed the bold from the actual heading e.g. 1. Definitions - the number should not be bold but Definitions should be bold but .Font.Bold = Choose(i, 0, 0, 0, 0, 0, 0, 0) seems to work correctly. Image.PNG |
#23
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#24
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, so I have figured out the issue with the Define new Multilevel List, I just needed to update the code which now updates the dialog box correctly.
Code:
.NumberPosition = InchesToPoints(Choose(i, 0, 0, 0.5, 1, 1.5, 2, 2.5)) .TextPosition = InchesToPoints(Choose(i, 0.5, 0.5, 1, 1.5, 2, 2.5, 3)) Capture.PNG Code:
Sub ApplyMultiLevelHeadingNumbers_B() 'Run if Heading 4 is numbered (a) Application.ScreenUpdating = False Dim LT As ListTemplate, i As Long, n As Long, iLvl As Long Call DPU_RemoveFirstLineIndents Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True) For i = 1 To 6 With LT.ListLevels(i) .NumberFormat = Choose(i, "%1.", "%1.%2", "%1.%2.%3", "(%4)", "(%5)", "(%6)", "(%7)") .TrailingCharacter = wdTrailingTab .NumberStyle = Choose(i, wdListNumberStyleArabic, wdListNumberStyleArabic, _ wdListNumberStyleArabic, wdListNumberStyleLowercaseLetter, wdListNumberStyleLowercaseRoman, _ wdListNumberStyleUppercaseLetter, wdListNumberStyleArabic) .NumberPosition = InchesToPoints(Choose(i, 0, 0, 0.5, 1, 1.5, 2, 2.5)) .TextPosition = InchesToPoints(Choose(i, 0.5, 0.5, 1, 1.5, 2, 2.5, 3)) .Font.Bold = Choose(i, 0, 0, 0, 0, 0, 0, 0) 'Remove bold from heading numbers .Alignment = wdListLevelAlignLeft .ResetOnHigher = True .StartAt = 1 .LinkedStyle = "Heading " & i End With With ActiveDocument.Styles("Heading " & i) Select Case i Case 1, 2 .ParagraphFormat.LeftIndent = InchesToPoints(0.5) Case Else .ParagraphFormat.LeftIndent = InchesToPoints((i - 1) * 0.5) End Select .ParagraphFormat.FirstLineIndent = InchesToPoints(-0.5) .ParagraphFormat.Alignment = wdAlignParagraphJustify .Font.Name = "Arial" .Font.Italic = False .Font.ColorIndex = wdAuto .Font.Size = 10 End With Next Application.ScreenUpdating = True 'Call ApplyHeadingStyles_IfManual End Sub |
#25
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#26
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, yes I see your point, unfortunately the firm set the template up using that style so I can't get away from that or change it, never had a problem with cross referencing using two Heading 2 styles, it has always seemed to work - thanks for all your help with this, it has been very much appreciated.
|
#27
|
||||
|
||||
About the only way I could see of making that work would be to have the subordinate one to be an actual subordinate level (e.g. Heading 3), but with no list level number of its own. All the others would, of course, need to be moved down a level and omit the skipped level from their own numbering.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#28
|
|||
|
|||
VBA Change to correct Heading style
Hi Macropod, many thanks for all your help on this, it is and has been very much appreciated. I will now close this as resolved as it pretty much is, again, thank you. best regards, Shelley
|
|
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 |