Converting

I suspect, in the future, that the macro included below, which came from this page - Converting Automatic Numbering to Manual Numbering - will be useful in my efforts to link MS Word documents to my disaster recovery documentation at work. In my efforts to automate as many tasks as possible, macros are always an intriguing subject.

---

The ConvertNumbersToText command is not selective and will convert all types of numbering and bulleting. At times it is desirable to only convert or remove one type of numbering, for example a document may have satisfactory outline numbering but chaotic list numbering.

The macro ConvertOrRemoveNumbering will convert numbering and/or bullets to text or alternatively remove them for all selected paragraphs (to select the whole document press CTRL + A). Set the values of IncludeOutline, IncludeList and IncludeBullets to True or False as required. Also set RemoveSw to False to convert to text or True to remove numbering and/or bulleting.

However, if the style of a paragraph has numbering or bulleting attributes then re-applying the style will re-introduce numbering or bulleting and if the numbering had been converted rather than deleted then two numbers will appear. If you don’t want this to happen then you need to remove the numbering from the styles after the conversion to text. The RestoreStyles macro will re-apply styles for the selected paragraphs.

Removing and re-applying can be used to advantage where a document has a messy combination of style, list numbering and bulleting. It will give a “clean” copy that has only numbering and bulleting from styles.

Sub ConvertOrRemoveNumbering()
Dim j As Long
Dim jcount As Long
Dim k As Long
Dim nP As Long
Dim aRange As Range
Dim bRange As Range
Dim aPara As Paragraph

' ---- set constants for type of numbering -----
Const IncludeOutline = True
Const IncludeList = True
Const IncludeBullets = False

' ---- RemoveSW = True to remove, False to convert to text ---
Const RemoveSW = False

Set aRange = Selection.Range
Set bRange = Selection.Range
jcount = 0
' --- paragraphs in reverse order to preserve numbering ---
k = aRange.Paragraphs.Count
j = k
Do
Set aPara = aRange.Paragraphs(j)
nP = aPara.Range.ListFormat.ListType
If nP = 1 Then
If Selection.Paragraphs(1).Range.ListParagraphs.Count <> 1 Then nP = 0
End If
If nP = (IncludeList And (nP = 1 Or nP = 3)) Or _
(IncludeOutline And nP = 4) Or (IncludeBullets And (nP = 2 Or nP = 5)) Then
aPara.Range.Select
If RemoveSW = True Then
Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberAllNumbers
Else
Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberAllNumbers
End If
jcount = jcount + 1
End If
nextPara:
j = j - 1
Loop Until j < 1

bRange.Select
Selection.Start = Selection.Paragraphs(1).Range.Start
If RemoveSW Then
MsgBox jcount & " numbers/bullets removed"
Else
MsgBox jcount & " numbers/bullets converted to text"
End If
End Sub

Sub RestoreStyles()
Dim aPara As Paragraph
For Each aPara In Selection.Range.Paragraphs
aPara.Style = ActiveDocument.Styles(aPara.Style)
Next aPara
End Sub

---

All credit to Ken Endacott, who added the comment on 2015-05-28 at 00:46:54!