patternMinor
Word VBA Code to Automate Table Captioning
Viewed 0 times
automatecaptioningwordvbacodetable
Problem
I have a Word VBA script that auto-generates a table caption based on user input & a previous heading. Its purpose is to speed up editing & formatting of massive software documents (like the 1000+ page test procedure I'm currently reviewing). At this point, it's slightly quicker than scrolling back up, copying the heading manually, creating a caption, and pasting it in, but it lags a little. So, I'm looking for advice on optimizing & speeding it up.
I should note that this is only for my use (which might be obvious by the less than serious user prompts) and that I'm a tech writer who dabbles in VBA, rather than someone with a programming background.
Here's the script itself:
And here's the FindHeading function:
```
Function FindHeading(strHeadLevel As String) As String
'Gets the heading level as an input and finds the closest heading of that level before the selection.
Dim rngSelection As Range
'the initial selection
Dim rngPrev As Range
'The current paragraph to be evaluated.
Set rngSelection = Selection.Range
Set rngPrev = rngSelection.Previous(wdParagraph, 1)
'MsgBox (rngPrev.Text)
I should note that this is only for my use (which might be obvious by the less than serious user prompts) and that I'm a tech writer who dabbles in VBA, rather than someone with a programming background.
Here's the script itself:
Sub TestTableCaption()
Dim strCaption As String
Dim intTableType As Integer
Dim strTableType As String
strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
intTableType = Val(strTableType)
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets rid of dash from title. Doesn't actually work.
'MsgBox (strCaption)
Call GenerateCaption(strCaption, "Table")
End SubAnd here's the FindHeading function:
```
Function FindHeading(strHeadLevel As String) As String
'Gets the heading level as an input and finds the closest heading of that level before the selection.
Dim rngSelection As Range
'the initial selection
Dim rngPrev As Range
'The current paragraph to be evaluated.
Set rngSelection = Selection.Range
Set rngPrev = rngSelection.Previous(wdParagraph, 1)
'MsgBox (rngPrev.Text)
Solution
Clean everything up
Code should be written for other people (including future you) to read and understand. A key aspect of this is using consistent rules and conventions for laying out your code.
Indent logic levels, put comments on the same line as the thing being commented (where feasible), use whitespace liberally and consistently.
Same code, much easier to "see", at a glance, what's going on:
And now we can immediately see that your sub has 4 distinct sub-sections:
This leads us to the next key idea:
Refactor Mercilessly
Refactoring is the process of taking some set of operations, and abstracting them into their own Sub/Function. This makes your code cleaner, easier to follow, easier to modify and more re-usable.
Let's take this a step at a time.
Step 1: Get the user input string.
What are our requirements? The user needs to indicate which of 3 table types to change by inputting a number from 1 to 3.
First, a Descriptive, Unambiguous, name:
Second, get input.
Third, validate Input. Input must be a number. And it must be 1, 2 or 3. If the input is invalid, let's prompt the user to try again.
Sure, it's a bit verbose, but now you never need to touch this function again. And if your inputs change, you know exactly where to go to change things.
You've also now got an
Now, your sub looks like this:
```
Public Sub TestTableCaption()
Dim intTableType As String
intTableType = TypenumFromUser
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets
Code should be written for other people (including future you) to read and understand. A key aspect of this is using consistent rules and conventions for laying out your code.
Indent logic levels, put comments on the same line as the thing being commented (where feasible), use whitespace liberally and consistently.
Same code, much easier to "see", at a glance, what's going on:
Public Sub TestTableCaption()
Dim strTableType As String
strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
Dim intTableType As Integer
intTableType = Val(strTableType)
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets rid of dash from title. Doesn't actually work.
'MsgBox (strCaption)
Call GenerateCaption(strCaption, "Table")
End SubAnd now we can immediately see that your sub has 4 distinct sub-sections:
- Get user input number
- Convert number to the appropriate table style
- Find the relevant table heading and clean the text a bit
- Call
GenerateCaptionwith the (now cleaned) caption text.
This leads us to the next key idea:
Refactor Mercilessly
Refactoring is the process of taking some set of operations, and abstracting them into their own Sub/Function. This makes your code cleaner, easier to follow, easier to modify and more re-usable.
Let's take this a step at a time.
Step 1: Get the user input string.
What are our requirements? The user needs to indicate which of 3 table types to change by inputting a number from 1 to 3.
First, a Descriptive, Unambiguous, name:
Public Function TypenumFromUser() As LongSecond, get input.
Dim userInput As String
userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")Third, validate Input. Input must be a number. And it must be 1, 2 or 3. If the input is invalid, let's prompt the user to try again.
Public Function TypenumFromUser() As Long
'/ User must input a table type as a number
'/ Current options are 1, 2 or 3
'/ If the input is invalid, prompt the user to try again
GetNewInput:
Dim userInput As String
userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
Dim intCheck As Long
On Error GoTo BadUserInput
intCheck = CLng(userInput)
On Error GoTo 0
Dim isValidInput As Boolean
isValidInput = False
If IsWholeNumber(intCheck) Then
If intCheck >= 1 And intCheck <= 3 Then
isValidInput = True
End If
End If
If isValidInput Then
TypenumFromUser= intCheck
Else
GoTo BadUserInput
End If
CleanExit:
Exit Function
BadUserInput:
MsgBox "Input must be a whole number from 1 to 3. Please try again."
GoTo GetNewInput
End Function
Public Function IsWholeNumber(ByVal checkNum As Variant) As Boolean
'/ First check that input is a number.
'/ Then round to the nearest whole number.
'/ If the rounded number is the original number, then it is a whole number
IsWholeNumber = False
If IsNumeric(checkNum) And (Math.Round(checkNum, 0) = checkNum) Then
IsWholeNumber = True
End If
End FunctionSure, it's a bit verbose, but now you never need to touch this function again. And if your inputs change, you know exactly where to go to change things.
You've also now got an
IsWholeNumber function which you can use in other projects down the line. You should build these utility function up over time and before long, you'l have a whole module full of useful little functions that you can import into any new project.Now, your sub looks like this:
```
Public Sub TestTableCaption()
Dim intTableType As String
intTableType = TypenumFromUser
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets
Code Snippets
Public Sub TestTableCaption()
Dim strTableType As String
strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
Dim intTableType As Integer
intTableType = Val(strTableType)
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets rid of dash from title. Doesn't actually work.
'MsgBox (strCaption)
Call GenerateCaption(strCaption, "Table")
End SubPublic Function TypenumFromUser() As LongDim userInput As String
userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")Public Function TypenumFromUser() As Long
'/ User must input a table type as a number
'/ Current options are 1, 2 or 3
'/ If the input is invalid, prompt the user to try again
GetNewInput:
Dim userInput As String
userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
Dim intCheck As Long
On Error GoTo BadUserInput
intCheck = CLng(userInput)
On Error GoTo 0
Dim isValidInput As Boolean
isValidInput = False
If IsWholeNumber(intCheck) Then
If intCheck >= 1 And intCheck <= 3 Then
isValidInput = True
End If
End If
If isValidInput Then
TypenumFromUser= intCheck
Else
GoTo BadUserInput
End If
CleanExit:
Exit Function
BadUserInput:
MsgBox "Input must be a whole number from 1 to 3. Please try again."
GoTo GetNewInput
End Function
Public Function IsWholeNumber(ByVal checkNum As Variant) As Boolean
'/ First check that input is a number.
'/ Then round to the nearest whole number.
'/ If the rounded number is the original number, then it is a whole number
IsWholeNumber = False
If IsNumeric(checkNum) And (Math.Round(checkNum, 0) = checkNum) Then
IsWholeNumber = True
End If
End FunctionPublic Sub TestTableCaption()
Dim intTableType As String
intTableType = TypenumFromUser
Select Case intTableType
Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub
End Select
strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets rid of dash from title. Doesn't actually work.
'MsgBox (strCaption)
Call GenerateCaption(strCaption, "Table")
End SubContext
StackExchange Code Review Q#134574, answer score: 4
Revisions (0)
No revisions yet.