Dreamboat on Word: Word 2000, Word 2002, Word 2003 (On Office series)

Sample Word Macros

I’m providing several Word macros to give you an idea of the kind of automation that can be performed using VBA.

We have provided the code so that it is easy for you to type it. Whenever you see the ¶ symbol, it means you should hit Enter to create a paragraph return. Otherwise, you should not hit return while typing the code provided.

Some or all of these samples may be found in downloadable files on our website at www.TheOfficeExperts.com under the VBA Samples page.

Lines of code that begin with an apostrophe are comments and do not need to be typed into your code at all.

Sample Macro 1: Return Labels to Data

Many people create mail merge data sources in Word and then never save their data file, or are even unaware that it existed. This code is lengthy, but well worth typing.

Scenario

Suzy is to collect from each salesperson their lists of clients for sending holiday cards. She needs to combine the lists because it needs to be sorted in Zip Code order.

John sends a Word file full of labels to Suzy with a note that states, “Here’s my list from last year.”

Suzy wonders how she’s going to integrate John’s label-formatted addresses into the existing data list.

Solution

This macro is courtesy of my friend, Tom Giaquinto. After having manually converted many label files back to data source layouts, I can tell you that this macro can save you a great deal of time. This macro actually takes a mailing label-formatted document and converts it into a real data file, regardless of how many lines of text are on each label.

Questions on ways to perform this task quickly often come around the holidays when people are constructing holiday card mailing lists.

Type the following code into an inserted Module in your normal.dot and you’ll be able to run the code on any Word document.

Code

Sub DataSorcerer() Dim tbl As Table 'Table object Dim x As Integer, y As Integer 'Counters Dim intRows As Integer 'Total rows in table Dim intCols As Integer 'Total Columns in table Dim intGotVal As Integer 'Test for blank cells 'Select Entire Document and replace all line breaks 'with temporary place holder Selection.WholeStory With Selection.Find .Text = "^p" .Replacement.Text = "<REPLACEMENT>" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.WholeStory With Selection.Find .Text = "^l" .Replacement.Text = "<REPLACEMENT>" End With Selection.Find.Execute Replace:=wdReplaceAll 'Convert all tables to text w/ paragraph symbols 'used as delimiters For Each tbl In ActiveDocument.Tables tbl.Select tbl.Rows.ConvertToText Separator:=wdSeparateByParagraphs Next tbl 'Remove all section breaks from document Selection.WholeStory With Selection.Find .Text = "^b" .Replacement.Text = "^p" End With Selection.Find.Execute Replace:=wdReplaceAll 'Replace all double line breaks w/ single line breaks Selection.WholeStory With Selection.Find .Text = "^p^p" .Replacement.Text = "^p" End With Selection.Find.Execute Replace:=wdReplaceAll 'Replace temporary place holder w/ tabs to be used 'when text is converted to table Selection.WholeStory With Selection.Find .Text = "<REPLACEMENT>" .Replacement.Text = "^t" End With Selection.Find.Execute Replace:=wdReplaceAll 'Select entire document then convert to table w/ tabs 'as delimiter Selection.WholeStory Selection.ConvertToTable Separator:=wdSeparateByTabs 'Count rows and columns and set current table object intRows = ActiveDocument.Tables(1).Rows.Count intCols = ActiveDocument.Tables(1).Columns.Count Set tbl = ActiveDocument.Tables(1) 'Check for and remove blank rows For x = 1 To intRows intGotVal = 0 For y = 1 To intCols If tbl.Cell(x, y).Range.Characters.Count > 1 Then¶ intGotVal = intGotVal + 1 y = intCols Else 'Do Nothing End If Next y If intGotVal = 0 Then tbl.Rows(x).Delete x = x - 1 Else 'Do Nothing End If Next x 'Check for and remove blank columns For y = 1 To intCols If y > tbl.Columns.Count Then y = intCols Else intGotVal = 0 For x = 1 To intRows If tbl.Cell(x, y).Range.Characters.Count > 1 Then intGotVal = intGotVal + 1 x = intRows Else 'Do Nothing End If Next x If intGotVal = 0 Then tbl.Columns(y).Delete y = y - 1 Else 'Do Nothing End If End If Next y 'Reset column count and insert blank row 'adding a column heading to each cell intCols = tbl.Columns.Count tbl.Rows(1).Select Selection.InsertRows 1 For y = 1 To intCols tbl.Cell(1, y).Select Selection.Text = "Line" & y Next y End Sub

Sample Macro 2: Fun Joke and an Old Macro Virus

This macro emulates an old macro virus that was around about five years ago.

Scenario

This doesn’t serve any real purpose except to demonstrate how easy it is to create a macro “virus” and how to create a simple message box. The code does not otherwise affect the file; for instance, you’ll still get the opportunity to save it. See Macro Security on page 21-1 for a further explanation of this code and Figure 21-1 to see the message box it creates.

Solution

Type all three pieces of the code below into the ThisDocument of your normal.dot file.

Code

Private Sub Document_Close() MsgBox (Application.UserName &" is a big stupid jerk!") End Sub

Sample Macro 3: Default Open View

Scenario

When you open Word documents, particularly from other people, they may open in Normal view or some other view that you don't prefer. This code opens ALL new and previously created files in Print Layout View (in '97, this is called Page Layout view).

Solution

Type all three pieces of the code below into the ThisDocument of your normal.dot file. If you have already created macros with these names, you simply take the “guts” of the code, that is—all but the first and last lines—and place them below any existing code, and BEFORE the End Sub.

Code

Private Sub Document_New() Call SetView (wdPrintView) End Sub Private Sub Document_Open() Call SetView (wdPrintView) End Sub¶ Private Sub SetView(ByVal iView As Integer) With ActiveDocument.ActiveWindow If .View.SplitSpecial = wdPaneNone Then .ActivePane.View.Type = iView .ActivePane.View.Zoom.PageFit = wdPageFitBestFit¶ Else .View.Type = iView .View.Zoom.PageFit = wdPageFitBestFit End If End With End Sub

Sample Macro 4: Clean All VBA Code From a Document

Scenario

You may have or receive files that contain code. You don’t know what the code is for and you don’t want the code in the document. Or you regularly record macros in documents and then later want to delete the code from the documents.

Solution

Rather than use the manual method of removing code, as described on page 21-5, you can use this code. The code must be placed in your normal.dot file so that it can be safely used on other files. You can use this code to clean code from any Word document except normal.dot. The document must be open when you run the macro. To run it, hit Tools Macro Macros and double-click the DeleteAllVBA macro.

Double-click Project (Normal) at the left and hit Insert Module. In the code window for the new module, paste the following code:

Code

Public Sub DeleteAllVBA() Dim vbComp As Object For Each vbComp In ActiveDocument.VBProject.VBComponents With vbComp If .Type = 100 Then .CodeModule.DeleteLines 1, .CodeModule.CountOfLines Else ActiveDocument.VBProject.VBComponents.Remove vbComp End If . End With Next vbComp End Sub