Peltier Technical Services, Inc.
 

Excel Chart Add-Ins | Training | Custom Solutions | Charts and Tutorials | Peltier Tech Blog


Peltier Tech
Chart Add-Ins

Peltier Tech Waterfall Chart Utility
Peltier Tech Cluster-Stack Chart Utility
Peltier Tech Box and Whisker Chart Utility
Peltier Tech Marimekko Chart Utility
Peltier Tech Dot Plot Utility
Peltier Tech Cascade Chart Utility

 

Excel Dashboards

 

Books at Amazon.com

 

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

 

Peltier Tech Waterfall Chart Utility Peltier Tech Cluster-Stack Chart Utility Peltier Tech Box and Whisker Chart Utility Peltier Tech Marimekko Chart Utility Peltier Tech Dot Plot Utility Peltier Tech Cascade Chart Utility

 

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


Peltier Technical Services, Inc.

Excel Chart Add-Ins | Training | Custom Solutions | 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