Back to Samples Menu

VBA Samples

Microsoft Word

Custom Word Menu Sample Code

Create a custom menu in your template using VBA code. To get the different codes required for the button faces, we downloaded John Walkenbach's Face ID Identifier. Thank you, John. It's a great little tool!

To try this code, open a new document and hit Alt+F11. At the upper-left of the VBE window, double-click ThisDocument, and paste this code into the code window at the right. There are actually 13 macros in this code; one to create the toolbar and one macro for each of the 12 toolbar items. Each macro begins with bold text for reference only.

Private Sub Document_Open()
'The Dim statements make the rest of the code easier to create.

Dim Mybar As CommandBar
Dim cmd As CommandBarPopup
Dim i As Integer
Dim A(12) As Variant

CustomizationContext = ActiveDocument.AttachedTemplate

On Error Resume Next
'This checks if the menu already exists. If it does, it does not create a new one.

'The ampersand (&) in the name of the menu underlines the letter that follows it to give it a keyboard command (Alt-m) as many menus have. CommandBars("Menu Bar").Controls("Te&mplates").Caption = "Te&mplates"

If Not Err.Number = 0 Then

'Note that the parts of the array are ("Title of menu option","Macro to Run", FaceID for toolbar button)

A(1) = Array("Suat's Signature", "Ozgur", 92)
A(2) = Array("Anne's Signature", "Smith", 85)
A(3) = Array("Nancy's Signature", "Johnson", 89)
A(4) = Array("Dreamboat's Signature", "Dreamboat", 80)
A(5) = Array("Mickey's Signature", "Mouse", 98)
A(6) = Array("Insert Photo", "InsPic", 280)
A(7) = Array("Fix Picture", "FixPix", 1363)
A(8) = Array("Add Photo Heading", "PhotoCont", 314)
A(9) = Array("Insert Stopping Point", "StopPoint", 2528)
A(10) = Array("Find Last Stopping Point", "StartHere", 2526)
A(11) = Array("Print Just This Page", "PrtPg", 159)
A(12) = Array("Insert Landscape Page", "InsertLand", 6)

With CommandBars("Menu Bar").Controls

.Add(Type:=msoControlPopup, Before:=11).Caption = "Te&mplates"

End With

For i = 1 To UBound(A)

With CommandBars("Menu Bar").Controls("Te&mplates").Controls

Set myButton = .Add(Type:=msoControlButton)

With myButton

.Caption = A(i)(0)
.OnAction = A(i)(1)
.FaceId = A(i)(2)

End With

End With

Next i

Else

End If

End Sub

Private Sub Document_Close()

'This closes the Templates toolbar when the document is closed. It also keeps the user from changing the template. This is what we call an *on-event* procedure (macro) because it is run when the document is closed.

On Error Resume Next
CommandBars("Menu Bar").Controls("Te&mplates").Delete ActiveDocument.AttachedTemplate.Saved = True

End Sub

Sub Ozgur()

' Inserts a signature for Ozgur

Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Suat Ozgur"
Selection.TypeParagraph
Selection.TypeText Text:="Excellent VBA Coder who Provided this Code!"

End Sub

Sub Smith()

' Inserts a signature for Smith

Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Anne Smith"
Selection.TypeParagraph
Selection.TypeText Text:="Certified Know-It-All"

End Sub

Sub Johnson()

' Inserts a signature for Johnson

Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Nancy Johnson"
Selection.TypeParagraph
Selection.TypeText Text:="Certifiably Insane"
Selection.TypeParagraph
Selection.TypeText Text:="Vice President"

End Sub

Sub Dreamboat()

' Inserts a signature for Dreamboat

Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Dreamboat"
Selection.TypeParagraph
Selection.TypeText Text:="www.TheOfficeExperts.com"

End Sub

Sub Mouse()

' Inserts a signature for Mouse

Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Walt Disney World"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Mickey Mouse"
Selection.TypeParagraph
Selection.TypeText Text:="Entrepreneur"

End Sub

Sub Prtpg()

' This macro prints just the current page. It's popular! The underscore that follows Item:= tells the code to continue to the next line.

Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=""

End Sub

Sub PhotoCont()

' This macro gives the impression of a heading style without adding the text to the Table of Contents, which is based on heading styles.

Selection.TypeText Text:="Photographs of the Subject Property"
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Font.Size = 16
Selection.Font.Bold = wdToggle

' Many of the following items under WITH could be excluded by commenting them out (putting an apostrophe in front of them) or deleting them. Test it! Recorded macro code generally contains items that can be deleted because they don't apply for your use.

With Selection.ParagraphFormat

.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 3
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0

End With

Selection.EndKey Unit:=wdLine

End Sub

Sub FixPix()

'This macro sets the pictures to be exactly the same size and placement within this document. In this case, the pictures were all taken with the same camera and all were the same original size. The picture must be selected prior to running the macro.

Selection.InlineShapes(1).Fill.Visible = msoFalse
Selection.InlineShapes(1).Fill.Transparency = 0#
Selection.InlineShapes(1).Line.Weight = 0.75
Selection.InlineShapes(1).Line.Transparency = 0#
Selection.InlineShapes(1).Line.Visible = msoFalse
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Height = 246.94
Selection.InlineShapes(1).Width = 328.29
Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
Selection.InlineShapes(1).PictureFormat.CropRight = 0#
Selection.InlineShapes(1).PictureFormat.CropTop = 0#
Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.Style = ActiveDocument.Styles("Pictures")

End Sub

Sub StopPoint()

'This macro inserts text at the insertion point so that the StartHere macro can find the text and replace the STOPHERE text and allow the user to continue where they left off the day before.

Selection.TypeText Text:="STOPHERE"
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Color = wdColorRed
Selection.HomeKey Unit:=wdLine

End Sub

Sub StartHere()

'This macro finds the STOPHERE text, and deletes it, so that the user can continue working where they left off the day before.

Selection.Find.ClearFormatting

With Selection.Find

.Text = "stophere"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With

Selection.Find.Execute
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

End Sub

Sub InsertLand()

' This macro inserts a landscaped page, followed by a portrait page; another favorite.

Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveUp Unit:=wdLine, Count:=1

With Selection.PageSetup

.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1.25)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.SectionStart = wdSectionNewPage

End With

Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1

End Sub

Sub InsPic()

' The default folder for pictures is set under Tools-Options-File Locations. This macro uses the Insert Picture from File command to open that dialog box pointing to the default pictures folder.

Application.Dialogs(wdDialogInsertPicture).Show

End Sub