Graham Mayor

... helping to ease the lives of Microsoft Word users.

Many people access the material from this web site daily. Most just take what they want and run. That's OK, provided they are not selling on the material as their own; however if your productivity gains from the material you have used, a donation from the money you have saved would help to ensure the continued availability of this resource. Click the appropriate button above to access PayPal.

Some useful macro examples - page 1

Frequently the Word forums throw up some interesting exercises in macro programming. Some of the better examples that my fellow MVPs and I have come up with appear elsewhere in the Word pages on this site. This page offers a place to present some code examples that may have wider use, which you can adapt to your own requirements. I will add to the examples as they come up, but for the moment we will start with the InsertField dialog:

Insert Field formatting switch

The InsertField dialog (the illustrations are from Word 2003 (top) and 2007, other Word versions are similar) has the Preserve formatting during updates check box checked by default, with no obvious way of resetting that default. This adds a MERGEFORMAT switch to the inserted field. Frankly I have never found any real use for the switch and so I always uncheck it .... when of course I remember, so the first macro I created simply intercepts the InsertFile command and uses the SendKeys command to physically uncheck the box i.e.

Sub  InsertField()
SendKeys "{Tab 2} +{Tab 2}"
Dialogs(wdDialogInsertField).Show
End Sub

This worked fine, until fellow MVP Paul Edstein, who uses the pseudonym Macropod in the forums, baited me to produce a version which gave the user the opportunity to add a CHARFORMAT switch as an alternative to the MERGEFORMAT switch.

Inserting a field from the Insert > Field menu option (Insert > Quick Parts > Field in Word 2007/2010) opens the dialog with the check box unchecked, using the same method as above, but if you check the box, you are presented with a message box which offers the opportunity to choose the type of formatting switch, then adds the appropriate switch to the field.

Check the box and you will see the further dialog

The result is that the field may be inserted with either switch as appropriate e.g.

{ CREATEDATE \@ "dddd, dd MMMM yyyy" \* CHARFORMAT }

by selecting YES

{ CREATEDATE \@ "dddd, dd MMMM yyyy" \* MERGEFORMAT }

by selecting No

or none if the Insert Field Dialog box is left unchecked.{ CREATEDATE \@ "dddd, dd MMMM yyyy" }

Sub InsertField()
Dim oRng As Range
Dim i As Variant
Dim sSwitch As String
Dim strChoice As String
SendKeys "{Tab 2} +{Tab 2}"
Dialogs(wdDialogInsertField).Show
On Error Goto Finish 'User has cancelled
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Set oRng = Selection.Range
For i = 1 To oRng.Fields.Count
With oRng.Fields(i)
If InStr(1, .Code, "MERGEFORMAT") <> 0 Then
sSwitch = MsgBox("Use charformat in place of the mergeformat switch?", _
vbYesNo, _
"Insert Field")
If sSwitch = vbYes Then
.Code.Text = Replace(.Code.Text, _
"MERGEFORMAT", _
"CHARFORMAT")
End If
End If
.Update
End With
Next i
Selection.MoveRight Unit:=wdCharacter, Count:=1
Finish:
End Sub

 

I am informed, by the aforementioned Paul Edstein, that the SendKeys approach will not work under the Windows Vista operating system, returning error code 70: "Permission denied". This then negates the use of the above macro for Vista users, but I have included a modified version below with the SendKeys line removed and a separate step to remove the switch. It is not as elegant as un-checking the check box, but it does the job.

Windows Vista Version

The following will work in Windows XP also, but requires an extra step to overcome the SendKeys issue.

Sub InsertField()
Dim oRng As Range
Dim i As Variant
Dim sSwitch As String
Dim strChoice As String
Dialogs(wdDialogInsertField).Show
On Error Goto Finish 'User has cancelled
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Set oRng = Selection.Range
For i = 1 To oRng.Fields.Count
With oRng.Fields(i)
If InStr(1, .Code, "MERGEFORMAT") <> 0 Then
sSwitch = MsgBox("Use charformat in place of the mergeformat switch?", _
vbYesNo, _
"Insert Field")
If sSwitch = vbYes Then
.Code.Text = Replace(.Code.Text, _
"MERGEFORMAT", _
"CHARFORMAT")
End If
If sSwitch = vbNo Then
sSwitch = MsgBox("Remove switch?", _
vbYesNo, _
"Insert Field")
If sSwitch = vbYes Then
.Code.Text = Replace(.Code.Text, _
" \* MERGEFORMAT ", _
"")
End If
End If
End If
.Update
End With
Next i
Selection.MoveRight Unit:=wdCharacter, Count:=1
Finish:
End Sub

The Vista version of the macro has two message boxes. One of them is identical to the Windows XP version, the other is displayed when the user responds to the first box with 'No'

Number documents

There is a page on this site dedicated to numbering documents but on a number of occasions I have been asked for a variation of this to place an incrementing number at a bookmarked location in a series of documents. The example used here was created to print a batch of numbered receipts, and includes a second macro to reset the stored start number.

The macro uses a bookmark in the document template named RecNo

SubAddNoFromINIFileToBookmark()
Dim SettingsFile AsString
Dim Order As String
Dim iCount As String
Dim rRecNo AsRange
Dim i AsLong
iCount = InputBox("Print how many copies?", _
"Print Numbered Copies", 1)
If iCount = "" Then
Exit Sub
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
"DocNumber", "Order")
If Order = "" Then
Order = 1
End If
For i = 1 To iCount
Set rRecNo = ActiveDocument.Bookmarks("RecNo").Range
rRecNo.Text = Format(Order,
"00000")
With ActiveDocument
.Bookmarks.Add
"RecNo", rRecNo
.Fields.Update
.ActiveWindow.View.ShowFieldCodes = False
.PrintOut
End With
Order = Order + 1
Next i
System.PrivateProfileString(SettingsFile, "DocNumber", _
"Order") = Order
End Sub

Sub ResetStartNo()
Dim SettingsFile AsString
Dim Order As String
Dim sQuery As String
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
"DocNumber", "Order")
sQuery = InputBox("Reset start number?", "Reset", Order)
If sQuery = "" Then
Exit Sub
Order = sQuery
System.PrivateProfileString(SettingsFile, "DocNumber", _
"Order") = Order
End Sub

Instead of printing a batch of similar numbered documents, the following variation simply adds the incremented number to each new document created from the template at the bookmarked location named RecNo. The reset macro above will reset this version equally as the following uses the same stored number data.

Sub AutoNew()
Dim SettingsFile As String
Dim Order As String
Dim rRecNo As Range
Dim i As Long
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
"DocNumber", "Order")
If Order = "" Then
Order = 1
End If
Set rRecNo = ActiveDocument.Bookmarks("RecNo").Range
rRecNo.Text = Format(Order, "00000")
With ActiveDocument
.Bookmarks.Add "RecNo", rRecNo
.Fields.Update
.ActiveWindow.View.ShowFieldCodes = False
End With
Order = Order + 1
System.PrivateProfileString(SettingsFile, "DocNumber", _
"Order") = Order
End Sub

Paste unformatted text

If you paste text from the internet for example, the paste will bring across all the formatting of the web page, whereas users frequently require the pasted text to adopt the formatting of the document into which it is pasted. This can be achieved with Paste Special > Unformatted text, but the macro recorder will not accurately record that action so....

Sub PasteUnfText()
On Error GoTo oops
Selection.PasteSpecial _
DataType:=wdPasteText, _
Placement:=wdInLine
End
oops:
Beep
End Sub
 

Copy footnotes c/w formatting to a new document

Sub CopyFootnotes()
Dim sDoc As Document
Dim tDoc As Document
Dim sId As String
Set sDoc = ActiveDocument
Set tDoc = Documents.Add
For i = 1 To sDoc.Footnotes.Count
sId = sDoc.Footnotes(i).Index
sDoc.Footnotes(i).Range.Select
Selection.Copy
tDoc.Activate
With Selection
.Style = "Footnote Text"
.Font.Superscript = True
.TypeText sId & " "
.Font.Superscript = False
.Paste
.TypeParagraph
End With
sDoc.Activate
Next i
tDoc.Activate
End Sub

 

Send the current document from Word by e-mail as an attachment, with the header details pre-completed, e.g. for the return of a completed form document.

Sub Send_As_Mail_Attachment()

' Send the document as an attachment
' in an Outlook Email message
Dim bStarted As Boolean
Dim oOutlookApp As Object
Dim oItem As Object

On Error Resume Next

'Prompt the user to save the document
ActiveDocument.Save

'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")

'Outlook wasn't running, start it from code
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If

'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(0)

With oItem
.to = "someone@somewhere.com"
.Subject = "This is the subject"
.Attachments.Add ActiveDocument.FullName
.Display 'Optionally change to .Send
End With

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub

Toggle the SQL security entry in the registry through vba

You receive the "Opening this will run the following SQL command" message when you open a Word mail merge main document that is linked to a data source - http://support.microsoft.com/?kbid=825765

This linked page explains how to create registry entries to turn off the security message. Some users have been concerned about the security implications of turning off this warning message. The following code was conceived with that issue in mind. The macro creates the registry entry if it is not present and then toggles the setting between 0 and 1 each time the macro is run. It could therefore be adapted for use in a mail merge macro to switch off the warning while the particular merge was run, then switch it back on again on completion.

Sub ToggleSQLSecurity()
Dim WSHShell, RegKey, rKeyWord, wVer
Set WSHShell = CreateObject("WScript.Shell")
If Val(Application.Version) < 10 Then
'The security issue relates to
'Word versions from 10.0 (Word 2002)
MsgBox "This macro is for Word 2002 and later!", vbOKOnly, "Wrong Word Version"
Exit Sub
End If
Start:
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & wVer & "\Word\Options\"
On Error Resume Next
'The registry key does not exist
rKeyWord = WSHShell.RegRead(RegKey & "SQLSecurityCheck")
If rKeyWord = "" Then
WSHShell.regwrite RegKey & "SQLSecurityCheck", 1, "REG_DWORD" 'set it at zero
GoTo Start: 'and read it again
End If
If rKeyWord = 1 Then
WSHShell.regwrite RegKey & "SQLSecurityCheck", 0, "REG_DWORD"
MsgBox "SQL Security checking is switched off", vbInformation, "SQL Check"
Else
WSHShell.regwrite RegKey & "SQLSecurityCheck", 1, "REG_DWORD"
MsgBox "SQL Security checking is switched on", vbInformation, "SQL Check"
End If
End Sub

 

Click the links below for more Word macros

 

 

Macros list page 1

This page

  • Insert Field formatting switch
  • Number documents
  • Paste unformatted text
  • Copy footnotes c/w formatting to a new document
  • Send the current document from Word by e-mail as an attachment, with the header details pre-completed, e.g. for the return of a completed form document.
  • Toggle the SQL security entry in the registry through vba

Page 2

  • True title case
  • Extract acronyms to a new document
  • Format part of a found text string
  • Format part of a found text string in a list of items
  • Add a row to a table in a protected form
  • An alternative method of adding a row to a protected table

Page 3

  • Create a bar chart based on the content of a dropdown form field
  • Repeat a block of formatted text and form fields based upon the content of another form field
  • Colour a form field check box with a contrasting colour when it is checked.
  • Count times entered into a document
  • Transpose Characters
  • Insert Autotext Entry with VBA
  • Insert Building Blocks with VBA

Page 4

  • Replace a list of words from an array
  • Replace a list of words from a table
  • Replace a list of words from a table and offer a choice of replacements
  • Add tabs to centre of text area and right margin
  • Extract e-mail addresses from a document to a list
  • Fix scrambled view of some open type fonts in Word 2010
  • Word 2010 Print Preview