Peltier Technical Services, Inc.
 

Excel Charting Utilities | Custom Solutions | Training | Charts and Tutorials | PTS Blog


Peltier Tech
Chart Utilities

PTS Waterfall Chart Utility
PTS Cluster-Stack Column Chart Utility
PTS Box and Whisker Chart Utility
PTS Marimekko Chart Utility
PTS Dot Plot Utility
PTS Cascade Chart Utility

 

Excel Dashboards

 

Books at Amazon.com

 

Buy me a coffee

If this topic or the whole site has been helpful, please support further development by treating me to a cup of coffee.

 

Custom Drawing Command Bar

Here is some code that generates a custom drawing command bar with my favorite built-in buttons. I originally wrote it for PowerPoint, but being part of the Office object model, it translated to Excel with only very minor adjustments. Both versions are shown.

To use this code, from Excel or PowerPoint, press ALT+F11 to open the Visual Basic Editor. Choose Module from the Insert menu to open a new code module, copy the appropriate version of the procedure below, and paste it into the new code module. You can assign the procedure to a toolbar button, or link to a Workbook_Open event procedure in Excel. Run Create_Drawing_Menu to generate the new command bar, or Delete_Drawing_Menu to destroy it.

Excel Custom Drawing Command Bar

Option Explicit

Public Const MENU_NAME As String = "Custom Drawing Tools"

Sub Create_Drawing_Menu()
Dim MyBar As CommandBar
Dim MyPopup As CommandBarPopup
Dim MyButton As CommandBarButton

Delete_Drawing_Menu

Set MyBar = CommandBars.Add(Name:=MENU_NAME, _
    Position:=msoBarFloating, temporary:=True)

With MyBar
    
    ' Group
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=164)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Ungroup
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=165)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Regroup
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=338)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Left
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=664)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Align Center
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=668)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Right
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=665)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Top
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=666)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Align MIddle
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=669)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Bottom
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=667)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Distribute Horizontally
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=408)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Distribute Vertically
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=465)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Bring to Front
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=166)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Bring Forward
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=170)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Send Backward
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=171)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Send to Back
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=167)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Rotate Left
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=199)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Rotate Right
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=198)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Flip Horizontal
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=196)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Flip Vertical
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=197)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Basic Shapes
    Set MyPopup = .Controls.Add(Type:=msoControlButtonPopup, Id:=2632)
    With MyPopup
        .BeginGroup = True
    End With
    ' Connectors
    Set MyPopup = .Controls.Add(Type:=msoControlButtonPopup, Id:=2633)
    With MyPopup
        .BeginGroup = False
    End With
    ' Insert Picture
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=2619)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Crop
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=732)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Format Object
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=962)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Fill Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=1691)
    With MyPopup
        '.Style = msobuttonicon
        .BeginGroup = True
    End With
    ' Line Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=1692)
    With MyPopup
        .BeginGroup = False
    End With
    ' Font Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=401)
    With MyPopup
        .BeginGroup = False
    End With
    
    .Width = Application.Width
    .Top = 4 / 3 * (Application.Top + Application.Height) - .Height - 50
    .Left = 4 / 3 * Application.Left + (4 / 3 * Application.Width - .Width) / 2 '850
    .Visible = True
End With
    
End Sub

Sub Delete_Drawing_Menu()
    On Error Resume Next
    CommandBars(MENU_NAME).Delete
    On Error GoTo 0
End Sub

PowerPoint Custom Drawing Command Bar

Option Explicit

Public Const MENU_NAME As String = "Custom Drawing Tools"

Sub Create_Drawing_Menu()
Dim MyBar As CommandBar
Dim MyPopup As CommandBarPopup
Dim MyButton As CommandBarButton

Delete_Drawing_Menu

Set MyBar = CommandBars.Add(Name:=MENU_NAME, _
    Position:=msoBarFloating, temporary:=True)

With MyBar
    
    ' Group
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=164)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Ungroup
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=165)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Regroup
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=338)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Left
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=664)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Align Center
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=668)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Right
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=665)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Top
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=666)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Align MIddle
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=669)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Align Bottom
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=667)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Distribute Horizontally
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=408)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Distribute Vertically
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=465)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Relative to Slide
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=1039)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Bring to Front
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=166)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Bring Forward
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=170)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Send Backward
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=171)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Send to Back
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=167)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Rotate Left
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=199)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Rotate Right
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=198)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Flip Horizontal
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=196)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Flip Vertical
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=197)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Basic Shapes
    Set MyPopup = .Controls.Add(Type:=msoControlButtonPopup, Id:=2632)
    With MyPopup
        .BeginGroup = True
    End With
    ' Connectors
    Set MyPopup = .Controls.Add(Type:=msoControlButtonPopup, Id:=2633)
    With MyPopup
        .BeginGroup = False
    End With
    ' Insert Picture
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=931)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
    ' Crop
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=732)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Format Picture
    Set MyButton = .Controls.Add(Type:=msoControlButton, Id:=2624)
    With MyButton
        .Style = msoButtonIcon
        .BeginGroup = False
    End With
    ' Fill Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=1691)
    With MyPopup
        '.Style = msobuttonicon
        .BeginGroup = True
    End With
    ' Line Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=1692)
    With MyPopup
        .BeginGroup = False
    End With
    ' Font Color
    Set MyPopup = .Controls.Add(Type:=msoControlSplitButtonPopup, Id:=401)
    With MyPopup
        .BeginGroup = False
    End With
    
    .Width = Application.Width
    .Top = 4 / 3 * (Application.Top + Application.Height) - .Height - 50
    .Left = 4 / 3 * Application.Left + (4 / 3 * Application.Width - .Width) / 2 '850
    .Visible = True
End With
    
End Sub

Sub Delete_Drawing_Menu()
    On Error Resume Next
    CommandBars(MENU_NAME).Delete
    On Error GoTo 0
End Sub
 

 

Page copy protected against web site content infringement by Copyscape

 

PTS Waterfall Chart Utility PTS Cluster-Stack Column Chart Utility PTS Box and Whisker Chart Utility PTS Marimekko Chart Utility PTS Dot Plot Utility PTS Cascade Chart Utility

 

Create Excel dashboards quickly with Plug-N-Play reports.


Peltier Technical Services, Inc.

Commercial Utilities | Custom Solutions | Training | Charts and Tutorials | PTS Blog

Peltier Technical Services, Inc., Copyright © 2010. All rights reserved.
You may link to this article or portions of it on your site, but copying is prohibited without permission of Peltier Technical Services.

Microsoft Most Valuable Professional

Microsoft Most Valuable Professional

My MVP Profile