Sample Word Macros

< Day Day Up >

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.

Note

Document_Open in the normal.dot template is an event that occurs any time you open any document. Document_New in the normal.dot template is an event that occurs whenever you create a new document. Hence, this code does not open the Word application in the view that is coded, but will open documents and create new documents in the view that is coded.

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

< Day Day Up >