Sub rename_chapters()
Dim chapter_name As String
Dim chapter_num As Integer
chapter_name = ""
chapter_num = 0
para_count = ThisDocument.Paragraphs.Count
Selection.HomeKey Unit:=wdStory ' go to start of document
On Error GoTo error_handling
For para_loop = 1 To para_count ' go through each paragraph in the document counting words
If Left(ThisDocument.Paragraphs(para_loop).Range.Style, 7) = "Heading" Then
chapter_name = Mid(ThisDocument.Paragraphs(para_loop).Range.Text, 2, Len(ThisDocument.Paragraphs(para_loop).Range.Text) - 2)
chapter_num = chapter_num + 1
chapter_name = "Chapter " & num_to_words(chapter_num)
ThisDocument.Paragraphs(para_loop).Range.Text = Left(ThisDocument.Paragraphs(para_loop).Range.Text, 1) & chapter_name
ThisDocument.Paragraphs(para_loop).Range.Style = "Heading 4"
End If
Next para_loop
MsgBox "Paragraphs have been renamed.", vbOKOnly, "Operation complete"
End
error_handling:
If para_loop > para_count Then
MsgBox "Paragraphs have been renamed.", vbOKOnly, "Operation complete"
End
Else
para_loop = para_loop + 1
Resume
End If
End Sub
Function num_to_words(input_no As Integer)
Dim input_str As String
Dim output_str As String
input_str = Trim(Str(input_no))
output_str = ""
For digit_loop = 1 To Len(input_str)
Select Case digit_loop
Case 1
Select Case Mid(input_str, Len(input_str) - (digit_loop - 1), 1)
Case 0
output_str = "zero"
Case 1
output_str = "one"
Case 2
output_str = "two"
Case 3
output_str = "three"
Case 4
output_str = "four"
Case 5
output_str = "five"
Case 6
output_str = "six"
Case 7
output_str = "seven"
Case 8
output_str = "eight"
Case 9
output_str = "nine"
End Select
Case 2
Select Case Mid(input_str, Len(input_str) - (digit_loop - 1), 1)
Case 1
output_str = "ten-" & output_str
Case 2
output_str = "twenty-" & output_str
Case 3
output_str = "thirty-" & output_str
Case 4
output_str = "forty-" & output_str
Case 5
output_str = "fifty-" & output_str
Case 6
output_str = "sixty-" & output_str
Case 7
output_str = "seventy-" & output_str
Case 8
output_str = "eighty-" & output_str
Case 9
output_str = "ninety-" & output_str
End Select
Case 3
Select Case Mid(input_str, Len(input_str) - (digit_loop - 1), 1)
Case 1
output_str = "One hundred and " & output_str
Case 2
output_str = "Two hundred and " & output_str
Case 3
output_str = "Three hundred and " & output_str
Case 4
output_str = "Four hundred and " & output_str
Case 5
output_str = "Five hundred and " & output_str
Case 6
output_str = "Six hundred and " & output_str
Case 7
output_str = "Seven hundred and " & output_str
Case 8
output_str = "Eight hundred and " & output_str
Case 9
output_str = "Nine hundred and " & output_str
End Select
End Select
Next digit_loop
If Right(output_str, 5) = "-zero" Then ' change "twenty-zero" to "twenty" etc.
output_str = Left(output_str, Len(output_str) - 5)
End If
If Right(output_str, 9) = " and zero" Then ' change "one hundred and zero" to "one hundred" etc.
output_str = Left(output_str, Len(output_str) - 9)
End If
output_str = Replace(output_str, "ten-one", "eleven")
output_str = Replace(output_str, "ten-two", "twelve")
output_str = Replace(output_str, "ten-three", "thirteen")
output_str = Replace(output_str, "ten-four", "fourteen")
output_str = Replace(output_str, "ten-five", "fifteen")
output_str = Replace(output_str, "ten-six", "sixteen")
output_str = Replace(output_str, "ten-seven", "seventeen")
output_str = Replace(output_str, "ten-eight", "eighteen")
output_str = Replace(output_str, "ten-nine", "nineteen")
output_str = UCase(Left(output_str, 1)) & Right(output_str, Len(output_str) - 1) ' capitalise first letter
num_to_words = output_str
End Function