How to add UI to Publisher for your macro code
In this post I wanted to cover something simple that might come up handy when trying to add custom controls to Publisher’s UI that can serve as entry points for your macro subroutines. For that, I created a simple macro that adds a new button to the “Objects” toolbar. Then it creates a new toolbar and adds a button there too. The button uses a custom icon and whenever you click it, it runs a macro subroutine that will insert a custom shape. To be able to do that, we have to code a sub that will modify our UI and create the UI entry points for our functionality, then ensure that this sub runs whenever we open our document:
Sub AddMyEntryPoint()
Dim objectsCommandBar As commanBar
Dim myCommandBar As commandBar
Dim myButton1 As CommandBarButton
Dim myButton2 As CommandBarButton
Dim app As Application
Dim picPicture As IPictureDisp
Dim picMask As IPictureDisp
'Find the Objects toolbar
Set app = Application
Set objectsCommandBar = app.CommandBars("Objects")
'Create a new toolbar and dock it to the top
Set myCommandBar = app.CommandBars.Add("Insert Shape", MsoBarPosition.msoBarTop, False, True)
'Add a button to the objects command bar
Set myButton1 = objectsCommandBar.Controls.Add(MsoControlType.msoControlButton, , , , True)
'Add a buttom to my custom toolbar
Set myButton2 = myCommandBar.Controls.Add(MsoControlType.msoControlButton, , , , True)
'Load the pictures we'll use for our button
Set picPicture = stdole.StdFunctions.LoadPicture("c:\funkyimage.bmp")
Set picMask = stdole.StdFunctions.LoadPicture("c:\funkymask.bmp")
myButton1.Picture = picPicture
myButton1.Mask = picMask
myButton2.Picture = picPicture
myButton2.Mask = picMask
myButton1.OnAction = "DrawMyFunkyShape"
myButton2.OnAction = "DrawMyFunkyShape"
myCommandBar.Visible = True
End Sub
The first thing we need to do is to find the toolbar where we want to put our entry point in. In this case, since I’m inserting a shape, I’ll add my entry point to the “Objects” toolbar:
Set objectsCommandBar = app.CommandBars("Objects")
I also want to add a toolbar of my own to add the button there as well. We want to name our toolbar “Insert Shape”, dock it to the top, make it not a menu bar and make it so that it removes itself when the document is closed (by forcing it to be temporary)
Set myCommandBar = app.CommandBars.Add ("Insert Shape", MsoBarPosition.msoBarTop, False, True)
The next step is to actually add the buttons that we’ll link to our sub. For that we’ll use the default values for most of the parameters except for temporary, which we’ll set to True so that the buttons are removed when we close the file.
Set myButton1 = objectsCommandBar.Controls.Add(MsoControlType.msoControlButton, , , , True)
Set myButton2 = myCommandBar.Controls.Add (MsoControlType.msoControlButton, , , , True)
Once we have our buttons, now we need to give them an icon and an action:
For the icons, you want to create 2 bitmaps, each 16 pixels by 16 pixels in size. One of the bitmaps represents the main icon the other one the mask. (So that we can make some of the pixels transparent). In my code I hardcode the paths to the images to my “c:” drive just for sample purposes.
Set picPicture = stdole.StdFunctions.LoadPicture("c:\funkyimage.bmp")
Set picMask = stdole.StdFunctions.LoadPicture("c:\funkymask.bmp")
myButton1.Picture = picPicture
myButton1.Mask = picMask
myButton2.Picture = picPicture
myButton2.Mask = picMask
The OnAction property on the button contains the name of the sub that will be run when the button is clicked.
myButton1.OnAction = "DrawMyFunkyShape"
myButton2.OnAction = "DrawMyFunkyShape"
myCommandBar.Visible = True
Now, we need to ensure that this method runs whenever we open the file. For that, we need to use the Open event in the document.
Private Sub Document_Open()
AddMyEntryPoint
End Sub
Finally, we need to implement the method that will execute our action. In our example, the method that we are using will insert a custom shape in the middle of the page. The shape is composed of a polyline and some ovals that get grouped to create the final shape. Since the focus of this example is not the actual sub that gets called, but the creation of the UI entry points, I’m not going to go into detail for this subroutine. Here is the code:
Sub DrawMyFunkyShape()
'Insert our funky shape on the middle of the page
Dim app As Application
Dim centerX As Single
Dim centerY As Single
Dim shapeHeight As Single
Dim shapeWidth As Single
Dim body As shape
Dim rightEye As shape
Dim leftEye As shape
Dim rightEar As shape
Dim leftEar As shape
Dim initialX As Single
Dim initialY As Single
Dim shapePoints(1 To 11, 1 To 2) As Single
Dim eyeWidth As Single
Dim eyeHeight As Single
Dim earWidth As Single
Dim earHeight As Single
eyeWidth = 10
eyeHeight = 5
earWidth = 18
earHeight = 9
shapeHeight = 100
shapeWidth = 100
Set app = Application
centerX = app.ActiveDocument.ActiveView.ActivePage.Width / 2
centerY = app.ActiveDocument.ActiveView.ActivePage.Height / 2
initialX = centerX - shapeWidth / 2
initialY = centerY - shapeHeight / 2
'Our funky shape will be a polyline grouped with 4 ovals: 2 for the eyes and 2 for the ears
shapePoints(1, 1) = initialX
shapePoints(1, 2) = initialY
shapePoints(2, 1) = initialX + shapeWidth
shapePoints(2, 2) = initialY
shapePoints(3, 1) = initialX + ((shapeWidth / 3) * 2)
shapePoints(3, 2) = initialY - ((shapeHeight / 3) * 2)
shapePoints(4, 1) = initialX + shapeWidth
shapePoints(4, 2) = initialY - (((shapeHeight / 3) * 2) + (shapeHeight / 12))
shapePoints(5, 1) = initialX + shapeWidth
shapePoints(5, 2) = initialY - (((shapeHeight / 3) * 2) + ((shapeHeight / 12) * 2))
shapePoints(6, 1) = initialX + ((shapeWidth / 4) * 3)
shapePoints(6, 2) = initialY - shapeHeight
shapePoints(7, 1) = initialX + (shapeWidth / 4)
shapePoints(7, 2) = initialY - shapeHeight
shapePoints(8, 1) = initialX
shapePoints(8, 2) = initialY - (((shapeHeight / 3) * 2) + ((shapeHeight / 12) * 2))
shapePoints(9, 1) = initialX
shapePoints(9, 2) = initialY - (((shapeHeight / 3) * 2) + (shapeHeight / 12))
shapePoints(10, 1) = initialX + (shapeWidth / 3)
shapePoints(10, 2) = initialY - ((shapeHeight / 3) * 2)
shapePoints(11, 1) = initialX
shapePoints(11, 2) = initialY
'Add the body
Set body = app.ActiveDocument.ActiveView.ActivePage.Shapes.AddPolyline(shapePoints)
'Add the eyes and ears
Set rightEye = app.ActiveDocument.ActiveView.ActivePage.Shapes.AddShape(msoShapeOval, initialX + ((shapeWidth / 3) * 2), initialY - ((shapeHeight / 12) * 10), eyeWidth, eyeHeight)
Set leftEye = app.ActiveDocument.ActiveView.ActivePage.Shapes.AddShape(msoShapeOval, initialX + (shapeWidth / 3) - eyeWidth, initialY - ((shapeHeight / 12) * 10), eyeWidth, eyeHeight)
Set rightEar = app.ActiveDocument.ActiveView.ActivePage.Shapes.AddShape(msoShapeOval, initialX + ((shapeWidth / 4) * 3), (initialY - shapeHeight) - (earHeight / 2), earWidth, earHeight)
Set leftEar = app.ActiveDocument.ActiveView.ActivePage.Shapes.AddShape(msoShapeOval, initialX + (shapeWidth / 4) - earWidth, (initialY - shapeHeight) - (earHeight / 2), earWidth, earHeight)
'Fills
'Blue Fill
body.Fill.ForeColor.RGB = RGB(0, 0, 255)
rightEar.Fill.ForeColor.RGB = RGB(0, 0, 255)
leftEar.Fill.ForeColor.RGB = RGB(0, 0, 255)
'White Fill
rightEye.Fill.ForeColor.RGB = RGB(255, 255, 255)
leftEye.Fill.ForeColor.RGB = RGB(255, 255, 255)
'Select all and group
body.Select (True)
rightEar.Select (False)
leftEar.Select (False)
rightEye.Select (False)
leftEye.Select (False)
app.Selection.ShapeRange.Group
End Sub
Here is a screenshot of what the final results looks like:
Then, after you click on the button, we call the sub and our custom shape gets inserted into the document
Hopefully you’ll find this useful when working with macros in Publisher. You can find the publication with the macro and the icons that I’m using from this location.
About the contributor: Miguel Gonzalez-Gongora is a Software Design Engineer in Test and has worked for Microsoft for 4 years, all of them in the Publisher Test Team. Besides writing macros using Publisher, he is the resident expert in tequila in all its permutations.