Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 07-12-2022, 01:52 PM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default


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]
Reply With Quote
  #17  
Old 07-12-2022, 11:43 PM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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
Reply With Quote
  #18  
Old 07-14-2022, 05:07 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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.
Reply With Quote
  #19  
Old 07-14-2022, 04:10 PM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #20  
Old 07-15-2022, 07:12 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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
Reply With Quote
  #21  
Old 07-16-2022, 03:37 PM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #22  
Old 07-17-2022, 06:19 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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
Reply With Quote
  #23  
Old 07-17-2022, 04:17 PM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by Shelley Lou View Post
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?
I believe that's just how the Define new Multilevel List dialog box works.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #24  
Old 07-18-2022, 06:05 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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))
You mentioned in a previous post why do I use two Heading 2 levels, one is set up to be plain text and the second one (Heading 2(Title) is when Heading 2 is a bold title within the same document. Heading 2(Title) is set up as style based on Heading 2 but when running one of my applymultilevel codes Heading 2(Title) does not update and therefore the numbering doesn't follow in sequence. Does VBA class this as another style even though its based on Heading 2?

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
Reply With Quote
  #25  
Old 07-18-2022, 07:25 AM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by Shelley Lou View Post
You mentioned in a previous post why do I use two Heading 2 levels, one is set up to be plain text and the second one (Heading 2(Title) is when Heading 2 is a bold title within the same document. Heading 2(Title) is set up as style based on Heading 2 but when running one of my applymultilevel codes Heading 2(Title) does not update and therefore the numbering doesn't follow in sequence. Does VBA class this as another style even though its based on Heading 2?
You can't have two headings at the same multi-level list numbering level, so only one of them can be part of that arrangement. Moreover, having two paragraphs with the same number potentially creates all sorts of problems (e.g. re cross-referencing - which paragraph is the reader supposed to understand from a cross-reference to 2.2?).
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #26  
Old 07-18-2022, 09:11 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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.
Reply With Quote
  #27  
Old 07-18-2022, 03:57 PM
macropod's Avatar
macropod macropod is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #28  
Old 07-25-2022, 01:17 AM
Shelley Lou Shelley Lou is offline VBA Change to correct Heading style Windows 10 VBA Change to correct Heading style Office 2016
Competent Performer
VBA Change to correct Heading style
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default 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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA Change to correct Heading style 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
VBA Change to correct Heading style Tab character causes style change to Heading 4 after macro Jennifer Murphy Word VBA 2 12-14-2015 02:31 AM
VBA Change to correct Heading style Unable to correct auto number of heading 5 KieranWood Word 2 03-03-2011 09:28 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:28 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft