rgmatthes
08-05-2009, 09:24 AM
Greetings once again, everyone!
I sometimes revise 200+ page documents, so I'm writing a macro to (re)format all the lists in a document automagically. When I started this project, I was told a macro couldn't do a job this complex, but now it's working and working well! The code is below, fresh from the oven. If you think it will be useful for your own purposes, feel free to take it/sample it/share it/whatever. It's not very well written, but it's clean and it gets the job done. :thumb
There's only a slight problem, however. My company uses different list styles for lists nested within tables. I want to write in a check to determine whether the list should be formatted using our normal list styles or our table list styles. Is there a way for VBA to check a listed item or a piece of text to determine whether it's stored inside a table?
BIG THANKS!
-------------
Here's how it works:
First, the macro searches for a list, then it checks an item in the list to see if it's a bulleted list item or otherwise. (At my company, we have one style for bulleted lists, one style for otherwise, so this simple check is enough.) The macro performs this check in a roundabout way because it's actually the most effective. It analyzes the listed item's marker - if the marker is a letter or number or is longer than a single character, then the item is part of an "otherwise" list (using letters, numbers, Roman numerals, whatever). If the marker is not any of those things (must be a symbol, then), then it's a bulleted list.
The macro then stores the list item's list level (1-9) and formats the list item to "Normal" to clear unwanted formatting. This still preserves font formatting like boldness. Then the macro formats the list item to a bullet (for now). The macro does this for each item in the list.
If the macro was formatting an "otherwise" list (not a bulleted list), it gathers more info while going through the list items. It stores the exact place the list started and the exact place the list ended (using character counts). Then after all bullet formatting but before moving onto the next list, it uses that info to select the entire list and reformat it to a numbered list style. This numbers all the list items correctly, thus avoiding the known issue that VBA can't explictly tell a list item to continue numbering from a previous list.
It does this for each list in a document. No issues have arisen yet, but the code is still new (just finished it this morning). Screenupdating is left on so you can see it work, so a screenrefresh is required at the macro's end. It doesn't preserve cursor position, either.
Sub Word_RestyleLists()
'
' Word_RestyleLists Macro
'
'
Dim x As Integer
Dim y As Integer
Dim start_list As Long
start_list = 0
Dim finish_list As Long
finish_list = 0
For Each list_instance In ActiveDocument.Lists
For Each item_instance In list_instance.ListParagraphs
If Len(item_instance.Range.ListFormat.ListString) = "1" Then
Select Case item_instance.Range.ListFormat.ListString
Case "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "1", "2", "3", "4", "5", "6", "7", "8", "9"
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
If start_list = 0 Then
start_list = Selection.Start
ElseIf Selection.Start < start_list Then
start_list = Selection.Start
End If
If Selection.End > finish_list Then
finish_list = Selection.End
End If
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
y = 1
Case Else
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
End Select
Else
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
If start_list = 0 Then
start_list = Selection.Start
ElseIf Selection.Start < start_list Then
start_list = Selection.Start
End If
If Selection.End > finish_list Then
finish_list = Selection.End
End If
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
y = 1
End If
Next
If y = 1 Then
Selection.SetRange Start:=start_list, End:=finish_list
Selection.Style = ActiveDocument.Styles("List Number")
y = 0
End If
start_list = 0
finish_list = 0
Next
Application.ScreenRefresh
End Sub
I sometimes revise 200+ page documents, so I'm writing a macro to (re)format all the lists in a document automagically. When I started this project, I was told a macro couldn't do a job this complex, but now it's working and working well! The code is below, fresh from the oven. If you think it will be useful for your own purposes, feel free to take it/sample it/share it/whatever. It's not very well written, but it's clean and it gets the job done. :thumb
There's only a slight problem, however. My company uses different list styles for lists nested within tables. I want to write in a check to determine whether the list should be formatted using our normal list styles or our table list styles. Is there a way for VBA to check a listed item or a piece of text to determine whether it's stored inside a table?
BIG THANKS!
-------------
Here's how it works:
First, the macro searches for a list, then it checks an item in the list to see if it's a bulleted list item or otherwise. (At my company, we have one style for bulleted lists, one style for otherwise, so this simple check is enough.) The macro performs this check in a roundabout way because it's actually the most effective. It analyzes the listed item's marker - if the marker is a letter or number or is longer than a single character, then the item is part of an "otherwise" list (using letters, numbers, Roman numerals, whatever). If the marker is not any of those things (must be a symbol, then), then it's a bulleted list.
The macro then stores the list item's list level (1-9) and formats the list item to "Normal" to clear unwanted formatting. This still preserves font formatting like boldness. Then the macro formats the list item to a bullet (for now). The macro does this for each item in the list.
If the macro was formatting an "otherwise" list (not a bulleted list), it gathers more info while going through the list items. It stores the exact place the list started and the exact place the list ended (using character counts). Then after all bullet formatting but before moving onto the next list, it uses that info to select the entire list and reformat it to a numbered list style. This numbers all the list items correctly, thus avoiding the known issue that VBA can't explictly tell a list item to continue numbering from a previous list.
It does this for each list in a document. No issues have arisen yet, but the code is still new (just finished it this morning). Screenupdating is left on so you can see it work, so a screenrefresh is required at the macro's end. It doesn't preserve cursor position, either.
Sub Word_RestyleLists()
'
' Word_RestyleLists Macro
'
'
Dim x As Integer
Dim y As Integer
Dim start_list As Long
start_list = 0
Dim finish_list As Long
finish_list = 0
For Each list_instance In ActiveDocument.Lists
For Each item_instance In list_instance.ListParagraphs
If Len(item_instance.Range.ListFormat.ListString) = "1" Then
Select Case item_instance.Range.ListFormat.ListString
Case "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "1", "2", "3", "4", "5", "6", "7", "8", "9"
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
If start_list = 0 Then
start_list = Selection.Start
ElseIf Selection.Start < start_list Then
start_list = Selection.Start
End If
If Selection.End > finish_list Then
finish_list = Selection.End
End If
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
y = 1
Case Else
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
End Select
Else
x = item_instance.Range.ListFormat.ListLevelNumber
item_instance.Range.Select
If start_list = 0 Then
start_list = Selection.Start
ElseIf Selection.Start < start_list Then
start_list = Selection.Start
End If
If Selection.End > finish_list Then
finish_list = Selection.End
End If
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Style = ActiveDocument.Styles("List Bullet")
Selection.Range.SetListLevel Level:=x
y = 1
End If
Next
If y = 1 Then
Selection.SetRange Start:=start_list, End:=finish_list
Selection.Style = ActiveDocument.Styles("List Number")
y = 0
End If
start_list = 0
finish_list = 0
Next
Application.ScreenRefresh
End Sub