Newsgroup: it.comp.appl.access
Titolo: Sottomenu

Salve a tutti,
ho già fatto una ricerchina con l'applet del sitocomune e con google ma non
ho trovato risposte (il che non vuol dire che non ci siano ma solo che non
le ho proprio trovate).
Il problema è questo:
secondo il libro "Le Macro di Office" della Mondadori con questo codice VBA
creo una nuova barra degli strumenti, aggiungo un menù di tipo popup,
aggiungo una voce al menù popup e dovrei aggiungere un sottomenu in
corrispondenza della precedente voce del menù....
Set reportistica = Application.CommandBars.Add("Reportistica", msoBarTop, ,
True)
    reportistica.Visible = True
    ' Aggiungiamo un l' elemento 'Report' alla commandBar Reportistica
    Set NewItem = reportistica.Controls.Add(Type:=msoControlPopup)
    With NewItem
        .BeginGroup = True
        .Caption = "Report"
        .Visible = True
    End With
    ' Aggiunta delle voci di menu
    With NewItem.Controls.Add 'Voce di menu
        .Caption = "Situazione Corrente"
        ' Aggiunta dei sottomenu
        With .Controls.Add("Tutti i gruppi") <---ERRORE: Proprietà o metodo
non supportati dall'oggetto.
[Omissis]
In effetti, consultando la guida in linea di Access 2000, una voce di un
menù popup è un oggetto che non risulta avere una collezione Controls.
Domanda:
E' possibile, e come, aggiungere un sottomenu in corrispondenza di una voce
di un menu?
Grazie in anticipo.
--
Simplex2
www.mdenittis.it

Visto l'affollamento di risposte :-), spiego meglio la domanda, forse
cretina, ma deriva dal fatto che ciň che ho letto su un libro ("Le Macro di
Office") non funziona e mi ha depistato.
E' possibile creare dei sottomenů con Access da codice VBA?
Se la risposta č affermativa, mi potreste indicare qualche paginetta web
cosi', con comodo, me le studio?
Grazie in anticipo.

 ha scritto nel messaggio
news:d42jnd$r4i$1...@canarie.caspur.it...

Ciao Simplex,
ti posto il codice per creare un barra  degli strumenti e per aggiungere un
sottomenu
Non l'ho mai provata, ma l'ho presa da un testo che ho studiato e ho fatto
"copia incolla"
Spero ti possa essere d'aiuto.
Se non dovesse funzionare fai sapere che mi rifaccio dare i soldi indietro !
Ciao
Sub AddNewCB()
   Dim CBar As CommandBar, CBarCtl As CommandBarControl
   On Error GoTo AddNewCB_Err
   ' Create a new floating toolbar and make it visible.
   Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
                              msoBarFloating)
   CBar.Visible = True
   ' Create a button with text on the bar and set some properties.
   Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
   With CBarCtl
      .Caption = "Button"
      .Style = msoButtonCaption
      .TooltipText = "Display Message Box"
      .OnAction = "=MsgBox(""You pressed a toolbar button!"")"
   End With
   ' Create a button with an image on the bar and set some
   ' properties.
   Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
   With CBarCtl
      .FaceId = 1000
      .Caption = "Toggle Button"
      .TooltipText = "Toggle First Button"
      .OnAction = "=ToggleButton()"
   End With
   ' Create a combo box control on the bar and set some properties.
   Set CBarCtl = CBar.Controls.Add(msoControlComboBox)
   With CBarCtl
      .Caption = "Drop Down"
      .Width = 100
      .AddItem "Create Button", 1
      .AddItem "Remove Button", 2
      .DropDownWidth = 100
      .OnAction = "=AddRemoveButton()"
   End With
   Exit Sub
AddNewCB_Err:
   MsgBox "Error " & Err.number & vbCr & Err.Description
   Exit Sub
End Sub
'****************************************************************
' This procedure is called from a button on the toolbar.
' It toggles the Visible property of another button on the bar.
'****************************************************************
Function ToggleButton()
   Dim CBButton As CommandBarControl
   On Error GoTo ToggleButton_Err
   Set CBButton = CommandBars("Sample Toolbar").Controls(1)
   CBButton.Visible = Not CBButton.Visible
   Exit Function
ToggleButton_Err:
   MsgBox "Error " & Err.number & vbCr & Err.Description
   Exit Function
End Function
'****************************************************************
'This procedure is called from a combo box on the toolbar
'It adds a button to the bar or removes it
'****************************************************************
Function AddRemoveButton()
   Dim CBar As CommandBar, CBCombo As CommandBarComboBox
   Dim CBNewButton As CommandBarButton
   On Error GoTo AddRemoveButton_Err
   Set CBar = CommandBars("Sample Toolbar")
   Set CBCombo = CBar.Controls(3)
   Select Case CBCombo.ListIndex
      ' If Create Button is selected, create a button on the bar
      Case 1
         Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)
         With CBNewButton
            .Caption = "New Button"
            .Style = msoButtonCaption
            .BeginGroup = True
            .Tag = "New Button"
            .OnAction = "=MsgBox(""This is a new button!"")"
         End With
      ' Find and remove the new button if it exists.
      Case 2
         Set CBNewButton = CBar.FindControl(Tag:="New Button")
         CBNewButton.Delete
   End Select
   Exit Function
AddRemoveButton_Err:
   ' If the button does not exist.
   If Err.number = 91 Then
      MsgBox "Cannot remove button that does not exist!"
      Exit Function
   Else
      MsgBox "Error " & Err.number & vbCr & Err.Description
      Exit Function
   End If
End Function
Sub cmdBarDelete()
   CommandBars("sample toolbar").Delete
End Sub
Sub AddNewMB()
   Dim MBar As CommandBar, MBarCtl As CommandBarControl
   Dim MBarSubCtl As CommandBarControl
   On Error GoTo AddNewMB_Err
   ' Create a new menu bar and dock it on the left.
   Set MBar = CommandBars.Add(Name:="Sample Menu Bar", Position:= _
                              msoBarTop, menuBar:=True, Temporary:=False)
   ' Make the menu bar visible.
   MBar.Visible = True
   ' Prevent users from undocking the menu bar.
   MBar.Protection = msoBarNoMove
   ' Create a popup control on the bar and set its caption.
   Set MBarCtl = MBar.Controls.Add(Type:=msoControlPopup)
   MBarCtl.Caption = "Displa&y"
   ' Create 2 controls on the Display popup and set some properties.
   Set MBarSubCtl = MBarCtl.Controls.Add(Type:=msoControlButton)
   With MBarSubCtl
      .Style = msoButtonIconAndCaption
      .Caption = "E&nable ClickMe"
      .FaceId = 59
      .OnAction = "=ToggleClickMe()"
      .Parameter = 1
      .BeginGroup = True
   End With
   Set MBarSubCtl = MBarCtl.Controls.Add(Type:=msoControlButton)
   With MBarSubCtl
      .Style = msoButtonIconAndCaption
      .Caption = "Di&sable ClickMe"
      .FaceId = 276
      .OnAction = "=ToggleClickMe()"
      .Parameter = 2
      .BeginGroup = True
   End With
   ' Add another control to the menu bar.
   Set MBarCtl = MBar.Controls.Add(Type:=msoControlButton)
   With MBarCtl
      .BeginGroup = True
      .Caption = "&ClickMe"
      .Style = msoButtonCaption
      .OnAction = "=MsgBox(""You clicked ClickMe"")"
   End With
   ' Add a control to make this menu bar invisible and bring back
   ' the system menu bar.
   Set MBarCtl = MBar.Controls.Add(Type:=msoControlButton)
   With MBarCtl
      .BeginGroup = True
      .Caption = "&Set Visibility Off"
      .Style = msoButtonCaption
      .OnAction = "=SampleMenuDisable()"
   End With
   Exit Sub
AddNewMB_Err:
   MsgBox "Error " & Err.number & vbCr & Err.Description
   Exit Sub
End Sub
'****************************************************************
' This procedure uses the Parameter property of a command bar
' control to execute a different action depending on which item
' you click on a popup menu.
'****************************************************************
Function ToggleClickMe()
   Dim MyMenu As CommandBar
   Dim MBarClickMe As CommandBarControl
   On Error GoTo ToggleClickMe_Err
   Set MyMenu = CommandBars("Sample Menu Bar")
   Set MBarClickMe = MyMenu.Controls(2)
   ' The ActionControl property of command bars returns the control
   ' whose OnAction property is running this procedure.
   With CommandBars.ActionControl
      Select Case .Parameter
         Case 1
            MBarClickMe.Enabled = True
         Case 2
            MBarClickMe.Enabled = False
      End Select
   End With
   Exit Function
ToggleClickMe_Err:
   MsgBox "Error " & Err.number & vbCr & Err.Description
   Exit Function
End Function
'****************************************************************
' This function restores the original menu bar. Because there can
' only be one system menu bar, you must hide the sample menu bar
' when you want to bring back the previous system menu bar.
'****************************************************************
Function SampleMenuDisable()
   Application.CommandBars("Sample Menu Bar").Visible = False
   Application.CommandBars("Menu Bar").Visible = True
End Function
Public Sub newSubMenu()
   Dim menuBar As CommandBar
   Dim newMenu As CommandBarControl
   Dim menuItem As CommandBarControl
   Dim subMenuItem As CommandBarControl
   Set menuBar = CommandBars.Add(menuBar:=True, Position:=msoBarTop, _
                                 Name:="Sub Menu Bar", Temporary:=True)
   menuBar.Visible = True
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&First Menu"
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&Second Menu"
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&Third Menu"
   Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
   With menuItem
      .Caption = "F&irst Sub"
      .FaceId = "356"
      .OnAction = "myTest"
   End With
   Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
   With menuItem
      .Caption = "S&econd Sub"
      .FaceId = "333"
      .OnAction = "otherTest"
   End With
   Set menuItem = newMenu.Controls.Add(Type:=msoControlPopup)
   menuItem.Caption = "Sub Menus"
   Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
   With subMenuItem
      .Caption = "Item 1"
      .FaceId = 321
      .OnAction = "firstMacro"
   End With
   Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
   With subMenuItem
      .Caption = "Item 2"
      .FaceId = 432
      .OnAction = "secondMacro"
   End With
End Sub

Grazie Sandro,
ora mo lo studicchio e poi ti faccio sapere fe funziona.
Ciao.
--
Simplex2
www.mdenittis.it