How to create in excel a form with a menu?

[oeiloff]

Actually in using only microsoft visual basic 6.0, it is quite easy to add a menu to a form by using the menu editor but what about excel? Could you please give me your support on this item.

In advance thank you for your support.

Regards,

Oeiloff.

[Carl A]

Ivan F. Moala has just the thing however, his download links don't seem to be working. You'll find it on page two of his downloads.

http://www.xcelfiles.com/API_Userform_MenuMaker.html

[oeiloff]

Okay, I'll look at it. I have now to take care of my kids.

Thank you very much for your support.

Regards,

Oeiloff

[oeiloff]

Actually I have went through your link, unfortunately that's not fully meeting my point. I mean I would like to get a code example on how I can add a menu inside a form by using excel software.
Thank you in advance if someone might help me.

[Bob Phillips]

Here is an idea I had a while back

http://www.vbaexpress.com/forum/show...=userform+menu

[oeiloff]

Hi Xld,

I thought I had a pretty simple question but it seems that to create a menu in a form by using vba (excel) it is not straightforward.
If your idea is to use VB to create a menu inside a form and then use the file and drag it to the excel project, it seems really a good idea, even though I thought it is was possible to simply create a menu inside a form by using vba, I am really surprised.

Any additional ideas are welcomed.

In any case, I appreciate your assistance. Thank you for your support.

Regards,

Oeiloff.

[Bob Phillips]

It is simple in VB, but in VBA there is no built-in menu capability.

[TomSchreiner]

Hi Oeiloff. What version of Office? You can create some very nice menus by anchoring commandbars inside your userform. Better than the boring VB menus. Of course there are no commandbars in v12. I don't know much about the ribbon.

[Aussiebear]

That's an interesting concept Tom. Would you care to explain a little bit more please?

[Bob Phillips]

Take a look at the link I posted Ted, that is exactly how my solution back then worked, creating simple commandbars that were attached to buttons that show those menus.

[Bob Phillips]

Oh BTW, it works just as well in 2007 as in previous versions. Even though 2007 has the ribbon, it still supports commandbars, after all right-click menus are just commandbars to name but one.

[oeiloff]

Hi Oeiloff. What version of Office? You can create some very nice menus by anchoring commandbars inside your userform. Better than the boring VB menus. Of course there are no commandbars in v12. I don't know much about the ribbon.

Hi TomSchreiner,

Actually I am using both vba 1997 and 2003.

[TomSchreiner]

Hi XLD.
"Oh BTW, it works just as well in 2007 as in previous versions."

Good news for this method that I figured would go by the way side...

Hi Oeiloff and Aussiebear.

Oeiloff. This method works just as well in VB when using Excel as a server.

This is as trimmed down as I could get it as far as the amount of code. The attached workbook shows a bit more.

Add a private class module named AnchorCbar.
[VBA]Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Type CbarProperties
Position As MsoBarPosition
Left As Long
Top As Long
Visible As Boolean
Protection As Long
End Type

Private Const GWL_STYLE As Long = -16
Private Const WS_CAPTION As Long = &HC00000
Private Const HORZRES As Long = 8

Private pCbar As CommandBar
Private pCbarHwnd As Long
Private pCbarProperties As CbarProperties
Private pIsAnchored As Boolean
Private pSpringControl() As CommandBarButton

Public Sub SetAnchor(HwndParent As Long, cBar As CommandBar)

Dim hdc As Long, x As Integer

Set pCbar = cBar
pCbarHwnd = FindWindow("MsoCommandBar", cBar.Name)

With pCbarProperties
.Position = cBar.Position
.Left = cBar.Left
.Top = cBar.Top
.Visible = cBar.Visible
.Protection = cBar.Protection
End With

cBar.Position = msoBarBottom
cBar.Position = msoBarFloating
cBar.Visible = True

If SetParent(pCbarHwnd, HwndParent) = 0 Then
cBar.Visible = True
pCbarHwnd = FindWindow("MsoCommandBar", cBar.Name)
DoEvents
SetParent pCbarHwnd, HwndParent
End If

hdc = GetDC(0)
ReDim pSpringControl(Int((GetDeviceCaps(hdc, HORZRES) - pCbar.Width) / 600))
ReleaseDC 0, hdc

For x = 0 To UBound(pSpringControl)
Set pSpringControl(x) = pCbar.Controls.Add(msoControlButton, , , , True)
pSpringControl(x).Width = 600
pSpringControl(x).Enabled = False
Next

MoveWindow pCbarHwnd, -2, -20, 0, 0, True
cBar.Protection = msoBarNoChangeDock + msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoResize
pIsAnchored = True
End Sub

Public Sub ReleaseAnchor()
Dim x As Integer
pCbar.Protection = msoBarNoProtection
For x = 0 To UBound(pSpringControl)
If Not pSpringControl(x) Is Nothing Then
pSpringControl(x).Delete
End If
Next
With pCbarProperties
SetParent pCbarHwnd, GetDesktopWindow
pCbar.Protection = .Protection
pCbar.Position = .Position
pCbar.Left = .Left
pCbar.Top = .Top
pCbar.Visible = .Visible
End With
pIsAnchored = False
End Sub

Private Sub Class_Terminate()
If pIsAnchored Then ReleaseAnchor
End Sub

Public Function PointsFromPixels(ByVal Pixels As Double, Horizontal As Boolean) As Single
Dim hdc As Long

hdc = GetDC(0)
PointsFromPixels = (72 / GetDeviceCaps(hdc, IIf(Horizontal, 88, 90))) * Pixels
ReleaseDC 0, hdc
End Function
[/VBA]

Add a userform named frmTemplate
[VBA]Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private ACbar As AnchorCbar

Public Sub AddCbar(cBar As CommandBar)
Set ACbar = New AnchorCbar
ACbar.SetAnchor FindWindow("ThunderDframe", Me.Caption), cBar
End Sub

Private Sub UserForm_Terminate()
Set ACbar = Nothing
End Sub[/VBA]

Example usage with the built in "Drawing" commandbar and a custom commandbar.
[VBA]Option Explicit

Private Sub CommandButton1_Click()
With frmTemplate
.Show False
.AddCbar Application.CommandBars("Drawing")
End With
End Sub

Private Sub CommandButton2_Click()
With frmTemplate
.Width = 455
.Show False
CreateCustomBar
.AddCbar Application.CommandBars("CustomBar")
End With
End Sub

Private Sub CreateCustomBar()
Dim x, y, TagNum

On Error Resume Next
Application.CommandBars("CustomBar").Delete
On Error GoTo 0

With Application.CommandBars
With .Add("CustomBar", msoBarFloating, , True)

With .Controls.Add(msoControlButton)
.Caption = "Undo"
.Style = msoButtonIconAndCaption
.FaceId = 128
.OnAction = "Sheet1.GenericOnActionProcedure"
TagNum = TagNum + 1: .Tag = TagNum
End With
With .Controls.Add(msoControlButton)
.Caption = "Redo"
.Style = msoButtonIconAndCaption
.FaceId = 129
.OnAction = "Sheet1.GenericOnActionProcedure"
TagNum = TagNum + 1: .Tag = TagNum
End With

For x = 1 To 4
With .Controls.Add(msoControlPopup)
.Caption = "Menu Item " & x
.BeginGroup = True
For y = 1 To 10
With .Controls.Add(msoControlButton)
.Caption = "Menu Item " & x & "-" & y
.OnAction = "Sheet1.GenericOnActionProcedure"
TagNum = TagNum + 1: .Tag = TagNum
End With
Next
End With
Next x

With .Controls.Add(msoControlComboBox)
.Width = 100
.Text = "Make Selection"
.OnAction = "Sheet1.GenericOnActionProcedure"
TagNum = TagNum + 1: .Tag = TagNum
For x = 1 To 30
.AddItem "Combo Item " & x
Next
End With

With .Controls.Add(msoControlButton)
.Caption = "Save"
.BeginGroup = True
.Style = msoButtonIconAndCaption
.FaceId = 3
.OnAction = "Sheet1.GenericOnActionProcedure"
TagNum = TagNum + 1: .Tag = TagNum
End With

End With
End With

End Sub

Public Sub GenericOnActionProcedure()
Select Case CInt(CommandBars.ActionControl.Tag)
Case 1
MsgBox "Undo"
Case 2
MsgBox "Redo"
Case 3 To 42
MsgBox CommandBars.ActionControl.Caption
Case 43
MsgBox "ComboBoxText: = " & CommandBars.ActionControl.Text & _
", ListIndex: " & CommandBars.ActionControl.ListIndex
Case 44
MsgBox "Save"
End Select
End Sub
[/VBA]

Zip file contains this code and a more extensive example as well. BTW, you can also anchor commandbars in ranges (will scroll with the worksheet). The code is a bit more complex.

[Aussiebear]

Tom, would you like to post this as a KB article?

[TomSchreiner]

Sure. How?

[oeiloff]

Sure. How?

Great thanks for your support. I have now to practise.

I really realized that this is not straigtforward as it is in VB.

[TomSchreiner]

"Great thanks for your support. I have now to practise."

Free Menu Maker from John Walkenbach

[mdmackillop]

Hi Tom,
There is a summary here re KB submissions
Regards
MD

[TomSchreiner]

Thanks MD

[Argh2]

"Oh BTW, it works just as well in 2007 as in previous versions."
Good news for this method that I figured would go by the way side...

Tom,
This works great on my machine in 2003 , but not in 2007.

In 2007, the commandbar gets created and pulled automagically into the Addins Ribbon area -- so it's not anchored on the userform.

Do I have to do something special in 2007 to get the command bar to anchor on the userform?

Thanks,
Argh2