Author Topic: pull down menus in VBA toolbars.  (Read 2842 times)

0 Members and 1 Guest are viewing this topic.

Barry Clark

  • Guest
pull down menus in VBA toolbars.
« on: December 15, 2005, 11:25:25 AM »
I can create toolbars with buttons with no issue. I am not seeing where I can create a pulldown menu. Is this not possible?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16717
  • Superior Stupidity at its best
Re: pull down menus in VBA toolbars.
« Reply #1 on: December 15, 2005, 11:33:07 AM »
you will need to use an API call to do that ... if I can find an example I'll post it ..
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Barry Clark

  • Guest
Re: pull down menus in VBA toolbars.
« Reply #2 on: December 15, 2005, 11:36:34 AM »
ROCK!

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: pull down menus in VBA toolbars.
« Reply #3 on: December 16, 2005, 08:03:38 AM »
No.
Me

hendie

  • Guest
Re: pull down menus in VBA toolbars.
« Reply #4 on: December 16, 2005, 08:53:24 AM »
another option although not really a menu is to use labels ~ you could simulate a menu pulldown with some chicanery using labels

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16717
  • Superior Stupidity at its best
Re: pull down menus in VBA toolbars.
« Reply #5 on: December 16, 2005, 08:59:35 AM »
Here is the code I used to simulate a menu, like hendie mentioned ..

This code is for the labels ... you need to just follow the example here to make your own
Code: [Select]
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim Menu As clsPopupMenu
 Dim MenuLine As Long
 'identify the label we are hovering over
 Label1.SpecialEffect = fmSpecialEffectSunken
 'create our menu class reference
 Set Menu = New clsPopupMenu
 'send the info to the class item
 'Note that the left of the control is 133% of the left position
 'of the VBA form, plus the left position of the label and
 'the top of the control is 133% of the top of the userform
 'plus the height of the label, plus the top of the label
 'plus the height of the top of the window caption bar
 ' 133% = 0.75 when doing division
 MenuLine = Menu.NewMenu((UserForm2.Left + Label1.Left) / 0.75, _
                         (UserForm2.Top + Label1.Top + Label1.Height + 20) / 0.75, _
                         "File", "Edit", "-", "Close") 'This line contains your menu items, note "-" is a separator
 'get the result from the user clicking the control
 'the case numbers correspond to the location in the parameters sent to
 'the NewMenu class. Remember, the first 2 elements are always
 'the position to create our control (X and Y)
 Select Case MenuLine
  'Case 1 'Our X position, do nothing
  'Case 2 'Our Y position, do nothing
  Case 3 'File
   'add "to do" code here
   MsgBox "User Clicked File"
  Case 4 'Edit
   'add "to do" code here
   MsgBox "User Clicked Edit"
  'Case 5 'A separator "-" so do nothing
  Case 6 'Close
   'add "to do" code here
   MsgBox "User Clicked Close"
 End Select
 'reset the label to normal
 Label1.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub Label2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim Menu As clsPopupMenu
 Dim MenuLine As Long
 'identify the label we are hovering over
 Label2.SpecialEffect = fmSpecialEffectSunken
 'create our menu class reference
 Set Menu = New clsPopupMenu
 'send the info to the class item
 'Note that the left of the control is 133% of the left position
 'of the VBA form, plus the left position of the label and
 'the top of the control is 133% of the top of the userform
 'plus the height of the label, plus the top of the label
 'plus the height of the top of the window caption bar
 ' 133% = 0.75 when doing division
 MenuLine = Menu.NewMenu((UserForm2.Left + Label2.Left) / 0.75, _
                         (UserForm2.Top + Label2.Top + Label2.Height + 20) / 0.75, _
                         "File", "-", "Edit", "Close") 'This line contains your menu items
 'get the result from the user clicking the control
 'the case numbers correspond to the location in the parameters sent to
 'the NewMenu class. Remember, the first 2 elements are always
 'the position to create our control (X and Y)
 Select Case MenuLine
  'Case 1 'Our X position, do nothing
  'Case 2 'Our Y position, do nothing
  Case 3 'File
   'add "to do" code here
   MsgBox "User Clicked File"
  'Case 4 'A separator "-" so do nothing
  Case 5 'Edit
   'add "to do" code here
   MsgBox "User Clicked Edit"
  Case 6 'Close
   'add "to do" code here
   MsgBox "User Clicked Close"
 End Select
 'reset the label to normal
 Label2.SpecialEffect = fmSpecialEffectFlat
End Sub

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 'present a scrolling effect when users move the mouse over
 'the labels across the top of the form
 'implement this in each label MouseMove event
 Label1.SpecialEffect = fmSpecialEffectRaised
 Label2.SpecialEffect = fmSpecialEffectFlat
End Sub

Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 'present a scrolling effect when users move the mouse over
 'the labels across the top of the form
 'implement this in each label MouseMove event
 Label1.SpecialEffect = fmSpecialEffectFlat
 Label2.SpecialEffect = fmSpecialEffectRaised
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 'reset all labels to flat when users move the mouse off
 'of the label. To get a better result, make sure you have
 'a minimum value of 1 for any label top and left position
 Label1.SpecialEffect = fmSpecialEffectFlat
 Label2.SpecialEffect = fmSpecialEffectFlat
End Sub


This is the code for the class required for the popup menus -- you need to call the class module clsPopupMenu for it to work
Code: [Select]
  Option Explicit
 
  Private Const MF_ENABLED = &H0&
  Private Const MF_SEPARATOR = &H800&
  Private Const MF_STRING = &H0&
  Private Const TPM_RIGHTBUTTON = &H2&
  Private Const TPM_LEFTALIGN = &H0&
  Private Const TPM_NONOTIFY = &H80&
  Private Const TPM_RETURNCMD = &H100&
 
  Private Declare Function CreatePopupMenu Lib "user32" () As Long
  Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
                  (ByVal hMenu As Long, _
                   ByVal wFlags As Long, _
                   ByVal wIDNewItem As Long, _
                   ByVal sCaption As String) As Long
  Private Declare Function TrackPopupMenu Lib "user32" _
                  (ByVal hMenu As Long, _
                   ByVal wFlags As Long, _
                   ByVal X As Long, _
                   ByVal Y As Long, _
                   ByVal nReserved As Long, _
                   ByVal hwnd As Long, _
                   nIgnored As Long) As Long
  Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
  Private Declare Function GetForegroundWindow Lib "user32" () As Long
  '
  Public Function NewMenu(ParamArray Param()) As Long
      Dim iMenu As Long
      Dim hMenu As Long
      Dim nMenus As Long
     
  ' create an empty popup menu
      hMenu = CreatePopupMenu()
  ' determine # of strings in paramarray
      nMenus = 1 + UBound(Param)
  ' put each string in the menu
  ' skipping the first 2 elements, those are the location for our menu
      For iMenu = 3 To nMenus
          If Trim$(CStr(Param(iMenu - 1))) = "-" Then
  ' the AppendMenu function has been superseeded by the InsertMenuItem
  ' function, but it is a bit easier to use.
  ' if the parameter is a single dash, a separator is drawn
              AppendMenu hMenu, MF_SEPARATOR, iMenu, ""
          Else
              AppendMenu hMenu, MF_STRING + MF_ENABLED, iMenu, CStr(Param(iMenu - 1))
          End If
      Next iMenu
  ' show the menu at the current cursor location;
  ' the flags make the menu aligned to the right (!); enable the right button to select
  ' an item; prohibit the menu from sending messages and make it return  the Index of the selected item.
  ' the TrackPopupMenu function returns when the user selected a menu item  or cancelled
  ' the window handle used here may be any window handle from your Application
  ' the return value is the (1-based) index of the menu item or 0 in case of cancelling
      iMenu = TrackPopupMenu(hMenu, TPM_RIGHTBUTTON + _
                                    TPM_LEFTALIGN + _
                                    TPM_NONOTIFY + _
                                    TPM_RETURNCMD, _
                                    Param(0), _
                                    Param(1), _
                                    0, _
                                    GetForegroundWindow(), _
                                    0)
  ' release and destroy the menu (for sanity)
      DestroyMenu hMenu
  ' return the selected menu item's index
      NewMenu = iMenu
  End Function
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Jürg Menzi

  • Swamp Rat
  • Posts: 597
  • Oberegg, Switzerland
Re: pull down menus in VBA toolbars.
« Reply #6 on: December 16, 2005, 10:17:54 AM »
Here is the code I used to simulate a menu, like hendie mentioned ..
Cool, thanks for the sample Keith... :-)
A computer's human touch is its unscrupulousness!
MENZI ENGINEERING GmbH
Current A2k14... A2k18 - Start R2.18

deegeecees

  • Guest
Re: pull down menus in VBA toolbars.
« Reply #7 on: December 16, 2005, 02:49:45 PM »
^ ditto

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16717
  • Superior Stupidity at its best
Re: pull down menus in VBA toolbars.
« Reply #8 on: December 16, 2005, 03:28:49 PM »
incidently I also use this to emulate a right click menu on my forms and controls ... I can create the popup menu and with the callback, decide what I should do .... as is evidenced by the Select Case statement
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Barry Clark

  • Guest
Re: pull down menus in VBA toolbars.
« Reply #9 on: December 19, 2005, 08:35:36 AM »
Awesome. When I find two minutes to rub together, I will give it a shot.

Thank you, sir.