Offering my meagre supply of Word macros

[onesecondglance]

Hello all,

in a previous life before novelling I wrote a lot of simple VBA applications in MS Office, mainly Word and Excel. So when I started writing my first novel I found myself writing macros to help me out. I'm sharing them here in case anyone else finds them useful or can offer any improvements or additions of their own.

If you are not that comfortable with using macros then don't be afraid - these will not alter the content of your documents unless stated. To use them, press Alt-F11 to open the VBA editor and paste them into a module in your document (I prefer not to write macros in the Normal.dot template for various reasons).

I should point out that my tips here refer specifically to Word 2003 running on Windows XP - I haven't tested them on any other versions or OSes.

[onesecondglance]

First up - one to count the number of words in each of the chapters of your novel. This assumes two things: first, that your chapter headings are formatted with a Heading style, and second, that you haven't used Heading styles elsewhere in the document.

Sub count_chapter_words()
 
Selection.HomeKey Unit:=wdStory ' go to start of document
 
Dim para_start As Integer
Dim chapter_name As String
Dim chapter_count As Integer
Dim msg_text As String
para_start = 0
chapter_name = ""
chapter_count = 0
msg_text = ""
para_count = ThisDocument.Paragraphs.Count
 
On Error Resume Next
 
For para_loop = 1 To para_count ' go through each paragraph in the document counting words
    If Left(ThisDocument.Paragraphs(para_loop).Range.Style, Len("Heading")) = "Heading" Then
        para_start = para_start + 1
    End If
    If para_start > 0 Or para_loop = para_count Then ' we've reached the next chapter or the end, spit out data for the last one
        If msg_text = "" Then
            msg_text = chapter_name & ": " & chapter_count & " words"
        Else
            msg_text = msg_text & Chr(10) & chapter_name & ": " & chapter_count & " words"
        End If
        ' reset counters, begin again
        chapter_name = Mid(ThisDocument.Paragraphs(para_loop).Range.Text, 2, Len(ThisDocument.Paragraphs(para_loop).Range.Text) - 2)
        chapter_count = 0
        para_start = 0
    End If
    chapter_count = chapter_count + ThisDocument.Paragraphs(para_loop).Range.ComputeStatistics(wdStatisticWords)
Next para_loop
 
msg_text = msg_text & Chr(10) & "Total: " & ThisDocument.Range.ComputeStatistics(wdStatisticWords) & " words"
MsgBox msg_text, vbOKOnly, "Words per chapter"
 
End Sub

The line chapter_name = Mid(ThisDocument.Paragraphs(para_loop).Range.Text, 2, Len(ThisDocument.Paragraphs(para_loop).Range.Text) - 2) uses the Mid function to strip both the leading and trailing character from the chapter name. This is because in my document I have a page break between each chapter, and Word picks up the page break character in the Heading. So this gets rid of them. You may need to adjust this line to suit your own document.

I also have a title page on my document that includes some Heading formatting, so I added an extra IF clause to check it wasn't any of the title page headings before adding to the msg_text string. I also adjusted the "total words" count at the end to deduct the number of words in my title page.

[onesecondglance]

OK, another one here - I often write bits and pieces on my wife's Macbook using TextEdit and then paste them back into Word when I get back to my own PC. However, Word and TextEdit use different ASCII characters for apostrophes and quotation marks by default. To correct this, this macro goes through your document and replaces each of the TextEdit-friendly characters with the ones Word would use instead.

***THIS WILL ALTER YOUR DOCUMENT, SO MAKE SURE YOU HAVE A BACKUP SAVED BEFORE YOU USE IT***
This works perfectly on my document, but make sure you have a backup saved before you try it on yours. I am not responsible if it messes up your work!

Sub replace_char()
 
ThisDocument.Content.Find.Execute FindText:=Chr(34), ReplaceWith:=Chr(147), Replace:=wdReplaceAll
ThisDocument.Content.Find.Execute FindText:=Chr(39), ReplaceWith:=Chr(146), Replace:=wdReplaceAll
 
End Sub

[onesecondglance]

OK, this routine will go through your novel and make sure the chapter numbers are correct, and will replace them if they're not. It works in the same way as the words per chapter counter above - so it will not work if your chapters do not have a Heading style and you haven't used Heading styles elsewhere.

***THIS WILL ALTER YOUR DOCUMENT, SO MAKE SURE YOU HAVE A BACKUP SAVED BEFORE YOU USE IT***
This works perfectly on my document, but make sure you have a backup saved before you try it on yours. I am not responsible if it messes up your work!

In Word you can use the Undo button to reverse the changes made by a macro, but even then you're basically an idiot if you try this on a document you haven't backed up and really care about.

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

The line chapter_name = chapter_name = Mid(ThisDocument.Paragraphs(para_loop).Range.Text, 2, Len(ThisDocument.Paragraphs(para_loop).Range.Text) - 2) uses the Mid function to strip both the leading and trailing character from the chapter name. This is because in my document I have a page break between each chapter, and Word picks up the page break character in the Heading. So this gets rid of them. You may need to adjust this line to suit your own document. Likewise, Left(ThisDocument.Paragraphs(para_loop).Range.Text , 1) & chapter_name is there to make sure that page break character stays there when the chapter name is overwritten.

I also have a title page on my document that includes some Heading formatting, so I added an extra IF clause to check it wasn't any of the title page headings before replacing the text.

I've also got all my chapter headings in the style Heading 4, hence this line: ThisDocument.Paragraphs(para_loop).Range.Style = "Heading 4". You will want to change this if your chapter headings have a different style. If you're unsure what style they are open the Task Pane, set it to "Styles and formatting", and then select one of your chapters - it will show you what style it is.

[onesecondglance]

OK, this one isn't VBA but uses field codes within your document to provide a rounded word count, the sort of thing you can put on your title page to give you an indicator of where you're up to. There are a couple of steps you need to follow to make this work, so make sure you do them in this order:

1) Go to the Tools menu and select Options. Find the "View" settings and set "Field shading" to "Always". This will make your life easier in the following steps.

2) In an empty spot in your document, press Ctrl-F9. This will make a pair of braces like these appear: { }

3) Inside the braces type this:

= round (( 999 - 23)/100,0)*100

23 is the number of words in my title page, so this reduces the word count by that amount. You should alter this number to reflect the number of words on your title page, or just remove the -23 if you don't have one.

4) Select the "999" bit and press Ctrl-F9. This will make another set of braces appear around the number.

5) Replace the "999" inside the braces with

NumWords

6) Right click on the word "round" and select "Update field".

7) You should now see the number of words in your document (excluding the title page as appropriate) rounded to the nearest hundred.

[onesecondglance]

Another one with field codes, this time to give you a number of words based on a specified average per page.

1) As above, set Field Shading to "Always" so you can see where you're working.

2) In an empty spot in your document, press Ctrl-F9. This will make a pair of braces like these appear: { }

3) Inside the braces type this:

= (100-1) * 300

300 is the number of words per page you want to use as an average. I've found from my own writing that 300 is a good guess at words per page in doublespaced 12pt Times New Roman; Courier comes in at around 250 per page. Adjust this number to suit your needs.

The -1 bit reduces the total count of pages by one - this is because I have a title page at the start of my document that I don't want to count. Adjust or remove this as necessary for your document.

4) Select the "100" bit and press Ctrl-F9. This will make another set of braces appear around the number.

5) Replace the "100" inside the braces with

NumPages

6) Right click on the "300" bit and select "Update field".

7) You should now see the number of words in your document based on the total number of pages (excluding the title page as appropriate) multiplied by the average number of words you specified (300 per page in my example above).

[onesecondglance]

Last one for now - it's easy enough to use the field code techniques above to have a custom page number in your slug line. So you can have your page numbering start wherever you like - you can choose not to count the title page, etc.

1) As above, set Field Shading to "Always" so you can see where you're working.

2) In the slug line (which will be the header, if you're being sensible) on your first page, press Ctrl-F9. This will make a pair of braces like these appear: { }

3) Inside the braces type this:

= (2-1)

2 is the page number of your first page of text. 1 is the number of pages you're deducting to account for your title page.

4) Select the "2" bit and press Ctrl-F9. This will make another set of braces appear around the number.

5) Replace the "2" inside the braces with

Page

6) Right click on the "-1" bit and select "Update field".

7) You should now see the current page number minus one (or however many you specified).

[three_act_climax]

Thank you for sharing this! Very helpful...

[onesecondglance]

No problem! If you need any help with any of these just let me know.

[thothguard51]

No offense, but I find it hard to download stuff from anyone I do not know or have associated with...

[onesecondglance]

None taken, perfectly understandable.

[jwgrahamjr]

onesecondglance, I really like your macro for "count words per chapter." I've been trying to mod that script to give me "number of pages per chapter," but I haven't been successful. I tried looping through sections versus paragraphs and using ComputeStatistics(wdStatisticPages) but I get a pagecount for the entire manuscript, not each section. Any suggestions?

[retlaw]

Originally Posted by onesecondglance

OK, this routine will go through your novel and make sure the chapter numbers are correct, and will replace them if they're not.

Me likey!!! Thank you!

I appreciate that there are legitimate security concerns. I shared those concerns. In my judgement, this script can act only within the confines of a single document. It does not look for work to do elsewhere, or need resources outside what is natively available. After this evaluation, I chose to copy (i.e., not download) the plain text (i.e., not an executable file), save, and use this macro.

I do not know the poster of this macro, and while I judged it to be safe, and it seems to have worked for me, ymmv! Thought it does seem to me that it would be pretty hard for this to go wrong (as long you are comfortable with macros and follow instructions).

[onesecondglance]

it's absolutely right to be cautious of accepting code from strangers... hopefully i'm less of an unknown quantity round here now, but a healthy amount of caution isn't a bad thing when it comes to this sort of thing.

jwgrahamjr - not sure off the top of my head, but i'll definitely have a look into this. fortunately for me, but unfortunately for the timeliness of my reply, i'm off on holiday tomorrow and don't get back until the week after next, but i promise i will look at this!

[Matera the Mad]

Wow, nice collection. I must play with them.

[onesecondglance]

Originally Posted by jwgrahamjr

onesecondglance, I really like your macro for "count words per chapter." I've been trying to mod that script to give me "number of pages per chapter," but I haven't been successful. I tried looping through sections versus paragraphs and using ComputeStatistics(wdStatisticPages) but I get a pagecount for the entire manuscript, not each section. Any suggestions?

Hey jwgrahamjr, I had a bash at repurposing that routine, but I ended up having to rewrite most of it! Word treats pages in a different way to paragraphs (makes sense - one's content, the other display) so you have to use different methods.

This routine looks for pages where the first line begins with "Prologue", "Chapter", or "Epilogue", and then counts the number of pages in each of those sections. Given I just came up with it about an hour ago, it will probably fall over if you have fancy-schmansy "Part 4: Chapter Seventeen" stuff going on, but its simplicity does make it pretty fast.

Sub count_chapter_pages()
 
Dim chapter_count As Integer ' chapter number of the current chapter
Dim chapter_name As String ' name of the current chapter
Dim chapter_pages As Integer ' number of pages in the current chapter
Dim msg_text As String ' the output text string
Dim page_count As Integer ' number of pages in the document
 
chapter_count = 0
chapter_name = ""
chapter_pages = 1
msg_text = ""
page_count = ThisDocument.ComputeStatistics(wdStatisticPages)
Selection.HomeKey Unit:=wdStory ' go to start of document
 
On Error Resume Next
 
For page_loop = 2 To page_count ' my doc starts on page 2
    Selection.GoTo What:=wdGoToPage, Name:=page_loop ' go to the next page in the loop
    Selection.MoveDown Unit:=wdLine, Count:=0
    Selection.Expand wdLine ' select the first line so we can read it
    If Left(Selection.Text, 8) = "Prologue" Or _
       Left(Selection.Text, 7) = "Chapter" Or _
       Left(Selection.Text, 8) = "Epilogue" Then ' new chapter
        chapter_count = chapter_count + 1 ' this is a contrivance to find out whether it's the first chapter or not
        If chapter_count = 1 Then ' for the first chapter we just need to start counting
            chapter_name = Left(Selection.Text, Len(Selection.Text) - 1)
            chapter_pages = 1
        Else ' next chapter onwards we need to dump the chapter_pages value into the msg_text variable
            If msg_text = "" Then ' first item in the list
                msg_text = chapter_name & ": " & chapter_pages & " pages"
            Else ' otherwise add a line break and append to the existing list
                msg_text = msg_text & Chr(10) & chapter_name & ": " & chapter_pages & " pages"
            End If
            ' then reset ready for the next count
            chapter_name = Left(Selection.Text, Len(Selection.Text) - 1)
            chapter_pages = 1
        End If
    ElseIf page_loop = page_count Then ' last page, tot up the last chapter
        If msg_text = "" Then ' first item in the list
            msg_text = chapter_name & ": " & chapter_pages & " pages"
        Else ' otherwise add a line break and append to the existing list
            msg_text = msg_text & Chr(10) & chapter_name & ": " & chapter_pages & " pages"
        End If
    Else ' if not a chapter start then just add to the main counter
        chapter_pages = chapter_pages + 1
    End If
Next page_loop
 
Selection.HomeKey Unit:=wdStory ' go back to start of document
msg_text = msg_text & Chr(10) & "Total: " & page_count & " pages"
MsgBox msg_text, vbOKOnly, "Pages per chapter"
 
End Sub

Note the line For page_loop = 2 To page_count. My manuscript has a title page (as noted in previous posts) so I start counting chapters from page 2. If you don't have a title page, or you have more than one page before the first chapter / prologue, then you'll need to alter the "2" value.

Cheers!

[alleycat]

onesecond, someone was asking about a macro to find missing quotation marks the other day, just as a check. I have one, but it's kind of a clunky thing (I didn't write it). I thought I might look at it some time and see if I could make it better, but I've got other stuff to do at the moment (I'm setting up a new computer).

If you would like to take a look at it, possibly improve it, and add it to your collection, let me know and I'll send it to you.

[onesecondglance]

Sure, send it on and I'll take a look. I can't promise I'll do anything with it, but I might learn a couple of new tricks!

[alleycat]

It's a short, simple macro. I'll find it when I get a chance and send it to you by PM.

[jwgrahamjr]

Originally Posted by onesecondglance

This routine looks for pages where the first line begins with "Prologue", "Chapter", or "Epilogue", and then counts the number of pages in each of those sections.

Thanks! For my manuscript, I used Style Heading.1 to denote individual Chapters, so I had to slightly mod the code. I also had to reference "ActiveDocument" instead of ThisDocument to prevent the wdStatisticsPages from returning 1. Seems to work! Here's the hack...

Sub count_chapter_pages()
 
Dim chapter_count As Integer ' chapter number of the current chapter
Dim chapter_name As String ' name of the current chapter
Dim chapter_pages As Integer ' number of pages in the current chapter
Dim msg_text As String ' the output text string
Dim page_count As Integer ' number of pages in the document
Dim chap_head As String

 
Selection.HomeKey Unit:=wdStory ' go to start of document
chapter_count = 0
chapter_name = ""
chapter_pages = 1
msg_text = ""
chap_head = "Chapter "
page_count = ActiveDocument.ComputeStatistics(wdStatisticPages)

 
On Error Resume Next
 
For page_loop = 3 To page_count ' my doc starts on page 3
    Selection.GoTo What:=wdGoToPage, Name:=page_loop ' go to the next page in the loop
    Selection.MoveDown Unit:=wdLine, Count:=0
    Selection.Expand wdLine ' select the first line so we can read it
    
    If Left(Selection.Range.Style, 7) = "Heading" Then
     ' new chapter
        chapter_count = chapter_count + 1 ' this is a contrivance to find out whether it's the first chapter or not
        If chapter_count = 1 Then ' for the first chapter we just need to start counting
            chapter_name = chap_head & chapter_count
            chapter_pages = 1
        Else ' next chapter onwards we need to dump the chapter_pages value into the msg_text variable
            If msg_text = "" Then ' first item in the list
                msg_text = chapter_name & ": " & chapter_pages & " pages"
            Else ' otherwise add a line break and append to the existing list
                msg_text = msg_text & Chr(10) & chapter_name & ": " & chapter_pages & " pages"
            End If
            ' then reset ready for the next count
            ' chapter_name = Left(Selection.Text, Len(Selection.Text) - 1)
            chapter_name = chap_head & chapter_count
            chapter_pages = 1
        End If
    ElseIf page_loop = page_count Then ' last page, tot up the last chapter
        If msg_text = "" Then ' first item in the list
            msg_text = chapter_name & ": " & chapter_pages & " pages"
        Else ' otherwise add a line break and append to the existing list
            msg_text = msg_text & Chr(10) & chapter_name & ": " & chapter_pages & " pages"
        End If
    Else ' if not a chapter start then just add to the main counter
        chapter_pages = chapter_pages + 1
    End If
Next page_loop
 
Selection.HomeKey Unit:=wdStory ' go back to start of document
msg_text = msg_text & Chr(10) & "Total: " & page_count & " pages"

MsgBox msg_text, vbOKOnly, "Pages per chapter"
 
End Sub

Thanks again...these macros are very useful.

[onesecondglance]

I got in a habit of always using ThisDocument instead of ActiveDocument after writing some macros that opened other files and dragged content in...

And you're welcome. I taught myself VBA just for messing around, so if anyone else gets benefit from my noodlings then it's all good...

[Cornelius Gault]

Here are some of my favorite macros. I use them for setting different colors in my document. If you can read VB, you can see there is no danger is setting a font color. These work in Windows XP, Windows 7, Word XP and Word 2010.

Sub Word_MakeTextBlack() ' Assigned as "black" button on Custom Ribbon Bar
Selection.Font.Color = wdColorAutomatic
End Sub

Sub Word_MakeTextGreen() ' Assigned as "green" button on Custom Ribbon Bar
Selection.Font.Color = wdColorGreen
End Sub

Sub Word_MakeTextOrange() ' Assigned as "orange" button on Custom Ribbon Bar
Selection.Font.Color = wdColorOrange
End Sub

Sub Word_MakeTextRed() ' Assigned as "red" button on Custom Ribbon Bar
Selection.Font.Color = wdColorRed
End Sub

Sub Word_RemoveExtraSpaces()
' Removes extra line spacing around the selected text. This comes in handy after pasting text in from a web page or another document.
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLingSpaceSingle
End With
End Sub