Word

Custom Menus and Toolbars

Ease of Use

Intermediate

Version tested with

 

Submitted by:

smozgur

Description:

Build a custom menu using VBA to ensure that everyone gets the menu without having to attach toolbars. 

Discussion:

If you have a template or document you use regularly that has some macros built into it, you can create a custom toolbar for it. When you send the file to someone else, the toolbar is lost. Building and deleting the custom toolbar or menu in VBA is the solution. Our example is rather lengthy, but provides several commonly used macros too. Get John Walkenbach's Face Identifier from http://j-walk.com/ss/excel/tips/tip67.htm to learn the index numbers of the icons you want on your toolbar. Note how the toolbar is deleted on close of the file. 

Code:

instructions for use

			

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.VBAExpress.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

How to use:

  1. Hit Alt+F11 to open the Visual Basic Editor (VBE).
  2. Double-click ThisDocument on the left, beneath your document's name.
  3. Paste the code into the window at right.
  4. Hit the Save toolbar button and close the VBE.
 

Test the code:

  1. Close and reopen the file.
 

Sample File:

No Attachment 

Approved by Anne Troy


This entry has been viewed 512 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express