#1
|
|||
|
|||
Multi-Level List on the Fly
I've been tinkering with some code for creating a custom multi-level list with the list levels linked to a unique paragraph style. It seems to work okay but there is some weirdness going on behind the scenes. Sharing here for anyone interested:
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 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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Multi-level list Weirdness | jthomas666 | Word | 13 | 09-16-2019 12:40 PM |
Applied Styles to Headings in Multi-Level List; now ALL second level headings are 1.XX | NNL | Word | 1 | 08-09-2017 02:52 PM |
Multi-level list hell | Shevaun | Word | 5 | 06-19-2017 07:43 PM |
How 2: Different Styles in Multi-Level List | BrianWren | Word | 1 | 10-21-2013 08:50 AM |
Headings + Multi-level list | falieson | Word | 1 | 06-18-2010 12:01 AM |