Post by simplex2Salve 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).
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.
E' possibile, e come, aggiungere un sottomenu in corrispondenza di una voce
di un menu?
Grazie in anticipo.
--
Simplex2
www.mdenittis.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