April 12, 2006

Menu Item Positioning - Rounded Comments

Yesterday I decided to add a new item to the right click menu. (By "right click menu", I am referring to the "standard" Cell menu, but not just the one you see normally when cells are selected and you right click, also the Print Preview one and XML one, three in total as far as I can tell)

Anyway, to set the position, we have to know where to place it. It's not just a matter of counting from the top - other code may add menu items and also the right click menu changes according to the cells selected. Have a look while selecting cells with and without comments to see what I mean. Menu items appear and disappear accordingly.

Using Control IDs are a way to get around this. I prefer this to using Captions, the main reason is I use both English and Japanese Excel, the Captions change depending on which computer I am using (work or home) or which language settings I am using. In this respect Control IDs are a lot more "International Friendly".

Here's some code to get the IDs.

Sub ShowMenuDetails()
    On Error Resume Next
    Dim cBar As CommandBar
    Dim ctrl As CommandBarControl
    Dim i As Long, AppCalc As Integer
    AppCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets.Add.Name = "Menu Details"
    Range("A1").Value = "Menu Name"
    Range("B1").Value = "Caption"
    Range("C1").Value = "ID No."
    Range("D1").Value = "Visible"
    Range("E1").Value = "Menu Type"
    Range("F1").Value = "(Local Name)"
    Range("A1:F1").Font.Bold = True
    i = 2
    For Each cBar In Application.CommandBars
        If cBar.BuiltIn Then
            Cells(i, 1) = cBar.Name
            Cells(i, 4) = cBar.Visible
            Cells(i, 6) = cBar.NameLocal
            Select Case cBar.Type
            Case msoBarTypeMenuBar: Cells(i, 5) = "Menu Bar"
            Case msoBarTypeNormal: Cells(i, 5) = "Normal"
            Case msoBarTypePopup: Cells(i, 5) = "Popup"
            End Select
            For Each ctrl In cBar.Controls
                If ctrl.BuiltIn Then
                    Cells(i, 2) = ctrl.Caption
                    Cells(i, 3) = ctrl.ID
                    i = i + 1
                End If
            Next
            i = i + 1
        End If
    Next
    Cells(1, 1).Select
    Columns.AutoFit
    Columns("C:C").HorizontalAlignment = xlCenter
    Application.Calculation = AppCalc
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

Now the menu item I want to add is Rounded Comments. They are included with my Utilities, but I thought it would be convenient to have them as a right click menu item also. Where I want to add the menu item is just above Format Cells so I look for the ID which is 855.

Sub AddCellMenu()
    On Error Resume Next
    Dim cPos As Integer
    Dim cBar As CommandBar
    Dim ctrl As CommandBarControl

    'Remove any previous menu items
    ResetCellMenu

    ' Refer to all "Cell" command bars
    For Each cBar In Application.CommandBars
        With cBar
            If .Controls.Parent.Name = "Cell" Then

                ' Get the Menu Item position from "Format Cells"
                cPos = .FindControl(ID:=855).Index

                ' Add the "Rounded Comments" menu item as below
                With .Controls.Add(Type:=msoControlButton, Before:=cPos)
                    .Caption = "&Rounded Comments"
                    .FaceId = 1589 ' change button image here
                    .OnAction = "LaunchRoundedCommentsForm"
                End With

            End If
        End With
    Next
    On Error GoTo 0
End Sub



Before adding a menu item we should be sure that previous cases are removed to avoid duplicates (Okay, I've been caught out before but this my "safe" code, a few extra nanoseconds won't hurt anyone). This is why ResetCellMenu is run with the above code before the new item is added. If a previous item doesn't exist, no problem, better safe than sorry. I'm using Captions in this case because I can be sure that mine won't change according to the language used, even if other menu items do.

Sub ResetCellMenu()
    On Error Resume Next
    Dim cBar As CommandBar
    Dim ctrl As CommandBarControl
    For Each cBar In Application.CommandBars
        For Each ctrl In cBar.Controls

            ' Find the "Rounded Comments" menu item and delete
            If ctrl.Caption = "&Rounded Comments" Then ctrl.Delete

        Next ctrl
    Next cBar
    On Error GoTo 0
End Sub

Finally, the code to be run. This launches the Rounded Comments form. (Thanks Andy and Jon for setting me straight on that)

Note "vbModeless" is being used. For Excel versions 2000 and up, this means you can select ranges while the user form is showing. This really is very convenient so I usually try to use it depending on what I actually want from the user form.

Sub LaunchRoundedCommentsForm()
    On Error Resume Next
    #If VBA6 Then
        UserFormRComments.Show vbModeless
    #Else
        UserFormRComments.Show
    #End If
    On Error GoTo 0
End Sub

Here's an addin that shows the above code and will enable you to add rounded comments. You can add the same comment to multiple cells at the same time, it is also a lot easier to edit them. (I might add some more options in future also)



The download link is here.

Update: New features have been added to the Rounded Comments form. Please refer to the next post.