Consulting

Results 1 to 10 of 10

Thread: Multi level list

  1. #1
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location

    Multi level list

    Greg Maxey recently published a section of code that purports to create a multi level list format on the fly. No one was able to respond at the other forum, but I was wondering if anyone here might be able to assist him. Apologies Greg, if I haven't given the correct description.

    Option Explicit
    'Note - change names to suit.
    Private Const m_strListStyleName As String = "My ML Numbered List"
    Private Const m_strStyleLevelPrefixName As String = "LL_"
    'Note - change the global indent value to suit.  Value is in points e.g., half inch is 36 points.
    Private Const m_lngIndent As Long = 21
    
    Sub Create_EditMultiLevelListStyle()
    Dim oListStyle As Style
    Dim oStyle As Style
    Dim oLL As ListLevel
    Dim lngPoints As Long, lngLevelIndex As Long
    Dim bRedefine As Boolean, bUpdate As Boolean
      'I created this VBA procedure because I think the built-in multilevel lists (MML) in Word look absolutely stupid.  I realize that is
      'a broad brush statement for out of 6 plus billion souls out there, some may feel the look of the MLL list this procedure creates is even worse.
      'Here we are.
      'I don't normally comment code heavily but make an exception here as I want any potential user to understand the mechanics and what is going on.
      'Trust me, some weird things go on.  Those are commented as well in hopes some smart guy or gal out there will jump in with suggestions
      'for improvement, explainaitons or fixes.
      'The primary goals of this code are to:
        'a) Produce a MML that is linked to 9 different paragraphs styles (one for each list level)
        'b) Produce a MML that has a unique list member index for each list level
        'c) Produce a MML with "lesser" indents that the built-in MML provided with Word
      bRedefine = False '***
      bUpdate = True
      On Error Resume Next
      'Get (or since it won't exist initially, create) the named list style.
      Set oListStyle = ActiveDocument.Styles(m_strListStyleName)
      If Err.Number <> 0 Then
        'If the named list style didn't exists then we create it now.
        Set oListStyle = ActiveDocument.Styles.Add(m_strListStyleName, wdStyleTypeList)
        bRedefine = True '***
        bUpdate = False
      End If
      DoEvents
    ReDefineAfterCreate:
      'Initialize the indent value
      lngPoints = 0
      On Error GoTo 0
      'Define the ListTemplate associated with the list style.
      With oListStyle.ListTemplate
        For lngLevelIndex = 1 To 9
          'Global actions for all nine list levels
          Set oLL = .ListLevels(lngLevelIndex)
          oLL.Alignment = wdListLevelAlignLeft
          'Note - the value of lngPoints is increased by the value you set with the constant m_lngIndent with each iteration of the this For ... Next loop
          oLL.NumberPosition = lngPoints
          oLL.TabPosition = lngPoints + m_lngIndent
          oLL.TrailingCharacter = wdTrailingTab
          oLL.ResetOnHigher = True
          'Link the list level to a unique paragraph style. Note - If that style doesn't exists, we create it with the error handler.
          On Error GoTo Err_Style
          Set oStyle = ActiveDocument.Styles(m_strStyleLevelPrefixName & lngLevelIndex)
          oLL.LinkedStyle = oStyle.NameLocal
          On Error GoTo 0
          Select Case lngLevelIndex
            Case 1
              'Note - for levels 1 - 3, I want my second line text to align under list member number/letter
              'To align under first character of list member text, append + m_lngIndent to .Text Position line.
              oLL.TextPosition = lngPoints '+ m_lngIndent
              oLL.NumberFormat = "%1."
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 2
              oLL.TextPosition = lngPoints  '+ m_lngIndent
              oLL.NumberFormat = "%2."
              oLL.NumberStyle = wdListNumberStyleUppercaseLetter
            Case 3
              oLL.TextPosition = lngPoints '+ m_lngIndent
              oLL.NumberFormat = "%3)"
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 4
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%4."
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
            Case 5
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%5."
              oLL.NumberStyle = wdListNumberStyleArabic
              oLL.Font.Underline = wdUnderlineSingle
            Case 6
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%6)"
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
            Case 7
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%7]"
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 8
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%8."
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
              oLL.Font.Underline = wdUnderlineSingle
            Case 9
              oLL.TextPosition = lngPoints + m_lngIndent
          End Select
          lngPoints = lngPoints + m_lngIndent
        Next lngLevelIndex
      End With
      '*** Here is the wierdness.
      'For whatever reason, when this procedure first creates the list style and associated linked paragraphs, the resulting linked LL_1 style paragraph assumes a mysterious
      '.25 inch hanging indent.  The only way I have found to work around this issue is to repeat ListTemplate definition steps.
      If bRedefine Then
        bRedefine = False
        GoTo ReDefineAfterCreate
      End If
      If bUpdate Then
        MsgBox "Defined changes to list and associated linked paragraph styles are completed.", vbInformation + vbOKOnly, "REPORT"
      Else
        MsgBox "This list style and associated linked paragraph styles have been created." & vbCr + vbCr _
          & "To reflect changes in the List Styles gallery please save, close and reopen the template file.", vbInformation + vbOKOnly, "REPORT"
          'Does anyone know how to force the List Styles gallery to refresh with code?
        Selection.Paragraphs(1).Style = m_strStyleLevelPrefixName & "1"
      End If
      '***
    lbl_Exit:
      Exit Sub
    Err_Style:
      Select Case Err.Number
        Case 5941
          'Create a unique paragraph style to serve as the linked paragraph for the indexed level.
          Set oStyle = ActiveDocument.Styles.Add(m_strStyleLevelPrefixName & lngLevelIndex, wdStyleTypeParagraph)
          oStyle.BaseStyle = "List Paragraph"
          Select Case lngLevelIndex
            Case 4 To 9
              'I specifically don't want additional white space after levels 4 through 9.  You can adjust this to suit your own taste.
              oStyle.NoSpaceBetweenParagraphsOfSameStyle = True
          End Select
        Case Else
          MsgBox Err.Number & " - " & Err.Description
      End Select
      Resume
    End Sub
    Sub DeleteStyleSet()
    'Use this procedure to remove the list and associated linked paragraph styles.
    'You should save and close the template, then reopen to reset the List Styles Gallery content.
    Dim oStyle As Style
      For Each oStyle In ActiveDocument.Styles
        If Left(oStyle.NameLocal, "3") = m_strStyleLevelPrefixName Or oStyle.NameLocal = m_strListStyleName Then
          oStyle.Delete
        End If
      Next
    End Sub
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  2. #2
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    348
    Location
    Assist how? What is the issue? What 'other forum'?
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Since you are at your investigative best, Greg's words were, "something weird going on in the background". If you had tried the code and you didn't notice anything, then perhaps the code is good to go, however if you did try the code and you did notice somethings weird, perhaps you could explain....
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    348
    Location
    Some clues on how to implement this code would be useful. I don't often code in Word. I can run code from a general module. No errors trigger. I get the MsgBox popup.

    Now I see a description of the "weirdness" as a comment in the code. I have no idea how to replicate the weirdness.
    Last edited by June7; 05-04-2024 at 09:45 PM.
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #5
    Okay Aussie, I'll try the code, but like June7 I dont code in word at all.

  6. #6
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Thanks Ian. No doubt it'll be something that you and I as average users will possibly not notice.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,383
    Location
    All,

    The issue (or weirdness) in the original code "was" even though I had set the TextPosition of Level 1 to lngPoints (or 0) in the Select Case Case 1 section of the code, that unless I ran the set up a second time:

    If bRedefine Then
      bRedefine = False
      GoTo ReDefineAfterCreate
      End If
    .

    ... there was an unwanted .5 inch hanging indent on the level 1 paragraph. You would see that if you stetted out the code snippet above.

    I took another look this morning and realized that if I initialized the .TextIndent = 0 earlier in the code then that problem disappears.

    The only question now is "Is there a way to updated the ListStyles gallery after creating the ListStyle with code.? As it is, I have to save, close and reopen the document before the new list style appears in the gallery.

    Here is the revised code:

    Option Explicit
    'Note - change names to suit.
    Private Const m_strListStyleName As String = "My ML Numbered List"
    Private Const m_strStyleLevelPrefixName As String = "LL_"
    'Note - change the global indent value to suit.  Value is in points e.g., half inch is 36 points.
    Private Const m_lngIndent As Long = 21
    
    Sub Create_EditMultiLevelListStyle()
    Dim oListStyle As Style
    Dim oStyle As Style
    Dim oLL As ListLevel
    Dim oLL1 As ListLevel
    
    Dim lngPoints As Long, lngLevelIndex As Long
    Dim bUpdate As Boolean
      'I created this VBA procedure because I think the built-in multilevel lists (MLL) in Word look absolutely stupid.  I realize that is
      'a broad brush statement for out of 6 plus billion souls out there, some may feel the look of the MLL list this procedure creates is even worse.
      'Here we are.
      'I don't normally comment code heavily but make an exception here as I want any potential user to understand the mechanics and what is going on.
      'Perhaps some smart guy or gal out there will jump in with suggestions for improvement, explainations or fixes.
      'The primary goals of this code are to:
        'a) Produce a MML that is linked to 9 different paragraphs styles (one for each list level)
        'b) Produce a MML that has a unique list member index for each list level
        'c) Produce a MML with "lesser" indents that the built-in MML provided with Word
      bUpdate = True
      On Error Resume Next
      'Get (or since it won't exist initially, create) the named list style.
      Set oListStyle = ActiveDocument.Styles(m_strListStyleName)
      If Err.Number <> 0 Then
        'If the named list style didn't exists then we create it now.
        Set oListStyle = ActiveDocument.Styles.Add(m_strListStyleName, wdStyleTypeList)
        bUpdate = False
      End If
      DoEvents
      'Initialize the indent value
      lngPoints = 0
      On Error GoTo 0
      'Define the ListTemplate associated with the list style.
      With oListStyle.ListTemplate
        For lngLevelIndex = 1 To 9
          'Global actions for all nine list levels
          Set oLL = .ListLevels(lngLevelIndex)
          oLL.Alignment = wdListLevelAlignLeft
          'Initialized text position. The hanging indent.
          oLL.TextPosition = 0
          'Note - the value of lngPoints is increased by the value you set with the constant m_lngIndent with each iteration of the this For ... Next loop
          oLL.NumberPosition = lngPoints
          oLL.TabPosition = lngPoints + m_lngIndent
          oLL.TrailingCharacter = wdTrailingTab
          oLL.ResetOnHigher = True
          'Link the list level to a unique paragraph style. Note - If that style doesn't exists, we create it with the error handler.
          On Error GoTo Err_Style
          Set oStyle = ActiveDocument.Styles(m_strStyleLevelPrefixName & lngLevelIndex)
          oLL.LinkedStyle = oStyle.NameLocal
          On Error GoTo 0
          Select Case lngLevelIndex
            Case 1
              'Note - for levels 1 - 3, I want my second line text to align under list member number/letter
              'To align under first character of list member text, append + m_lngIndent to .Text Position line.
              oLL.TextPosition = lngPoints '+ m_lngIndent
              Set oLL1 = oLL
              oLL.NumberFormat = "%1."
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 2
              oLL.TextPosition = lngPoints  '+ m_lngIndent
              oLL.NumberFormat = "%2."
              oLL.NumberStyle = wdListNumberStyleUppercaseLetter
            Case 3
              oLL.TextPosition = lngPoints '+ m_lngIndent
              oLL.NumberFormat = "%3)"
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 4
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%4."
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
            Case 5
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%5."
              oLL.NumberStyle = wdListNumberStyleArabic
              oLL.Font.Underline = wdUnderlineSingle
            Case 6
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%6)"
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
            Case 7
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%7]"
              oLL.NumberStyle = wdListNumberStyleArabic
            Case 8
              oLL.TextPosition = lngPoints + m_lngIndent
              oLL.NumberFormat = "%8."
              oLL.NumberStyle = wdListNumberStyleLowercaseLetter
              oLL.Font.Underline = wdUnderlineSingle
            Case 9
              oLL.TextPosition = lngPoints + m_lngIndent
          End Select
          lngPoints = lngPoints + m_lngIndent
        Next lngLevelIndex
      End With
      If bUpdate Then
        MsgBox "Defined changes to list and associated linked paragraph styles are completed.", vbInformation + vbOKOnly, "REPORT"
      Else
        MsgBox "This list style and associated linked paragraph styles have been created." & vbCr + vbCr _
          & "To reflect changes in the List Styles gallery please save, close and reopen the template file.", vbInformation + vbOKOnly, "REPORT"
          'Does anyone know how to force the List Styles gallery to refresh with code?
        Selection.Paragraphs(1).Style = m_strStyleLevelPrefixName & "1"
      End If
      '***
    lbl_Exit:
      Exit Sub
    Err_Style:
      Select Case Err.Number
        Case 5941
          'Create a unique paragraph style to serve as the linked paragraph for the indexed level.
          Set oStyle = ActiveDocument.Styles.Add(m_strStyleLevelPrefixName & lngLevelIndex, wdStyleTypeParagraph)
          oStyle.BaseStyle = "List Paragraph"
          Select Case lngLevelIndex
            Case 4 To 9
              'I specifically don't want additional white space after levels 4 through 9.  You can adjust this to suit your own taste.
              oStyle.NoSpaceBetweenParagraphsOfSameStyle = True
          End Select
        Case Else
          MsgBox Err.Number & " - " & Err.Description
      End Select
      Resume
    End Sub
    Sub DeleteStyleSet()
    'Use this procedure to remove the list and associated linked paragraph styles.
    'You should save and close the template, then reopen to reset the List Styles Gallery content.
    Dim oStyle As Style
      For Each oStyle In ActiveDocument.Styles
        If Left(oStyle.NameLocal, "3") = m_strStyleLevelPrefixName Or oStyle.NameLocal = m_strListStyleName Then
          oStyle.Delete
        End If
      Next
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  8. #8
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,383
    Location
    This is the link to the original post in the Word VBA Forum:

    https://www.msofficeforums.com/word-...-list-fly.html
    Greg

    Visit my website: http://gregmaxey.com

  9. #9
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,383
    Location
    Ted, thanks for prodding me into taking a fiftieth look at this . I think I have resolved the "weirdness."
    Greg

    Visit my website: http://gregmaxey.com

  10. #10
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    LOL... who knew a fiftieth look would do the trick.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •