J'avais recuperé un module permettant de creer un menu supplementaire dans
excel. Or ca semble ne pas fonctionner sur excel 2007 alors que tout
fonctionnait a merveilles sur 2000
Quelles sont les parties incompatibles ou tout le code est a supprimer?
Merci du temps pris a m'aider
Cordialement .
Lionel
voici le code
Sub CreateMenu()
Application.ScreenUpdating = False
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
Dim feuille As String
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the menus aren't duplicated
feuille = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("MenuSheet").Select
[i1].Value = 1
Call DeleteMenu
Sheets("MenuSheet").Select
[i1].Value = 0
Application.ScreenUpdating = False
Sheets(feuille).Select
' Initialize the row counter
Row = 2
' Add the menus, menu items and submenu items using
' data stored on MenuSheet
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Lionel
Bonsoir, Vraiment personne pour m'aider...?
SVP.... Lionel
"Lionel" a écrit dans le message de news:4b6414a1$0$17503$
Bonjour,
J'avais recuperé un module permettant de creer un menu supplementaire dans excel. Or ca semble ne pas fonctionner sur excel 2007 alors que tout fonctionnait a merveilles sur 2000 Quelles sont les parties incompatibles ou tout le code est a supprimer? Merci du temps pris a m'aider Cordialement . Lionel voici le code Sub CreateMenu() Application.ScreenUpdating = False ' This sub should be executed when the workbook is opened. ' NOTE: There is no error handling in this subroutine Dim feuille As String Dim MenuSheet As Worksheet Dim MenuObject As CommandBarPopup Dim MenuItem As Object Dim SubMenuItem As CommandBarButton Dim Row As Integer Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Location for menu data Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Make sure the menus aren't duplicated feuille = ActiveSheet.Name Application.ScreenUpdating = False Sheets("MenuSheet").Select [i1].Value = 1 Call DeleteMenu Sheets("MenuSheet").Select [i1].Value = 0 Application.ScreenUpdating = False Sheets(feuille).Select ' Initialize the row counter Row = 2 ' Add the menus, menu items and submenu items using ' data stored on MenuSheet Do Until IsEmpty(MenuSheet.Cells(Row, 1)) With MenuSheet MenuLevel = .Cells(Row, 1) Caption = .Cells(Row, 2) PositionOrMacro = .Cells(Row, 3) Divider = .Cells(Row, 4) FaceId = .Cells(Row, 5) NextLevel = .Cells(Row + 1, 1) End With Select Case MenuLevel Case 1 ' A Menu ' Add the top-level menu to the Worksheet CommandBar Set MenuObject = Application.CommandBars(1). _ Controls.Add(Type:=msoControlPopup, _ Before:=PositionOrMacro, _ Temporary:=True) MenuObject.Caption = Caption
Case 2 ' A Menu Item If NextLevel = 3 Then Set MenuItem > MenuObject.Controls.Add(Type:=msoControlPopup) Else Set MenuItem > MenuObject.Controls.Add(Type:=msoControlButton) MenuItem.OnAction = PositionOrMacro End If MenuItem.Caption = Caption If FaceId <> "" Then MenuItem.FaceId = FaceId If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item Set SubMenuItem > MenuItem.Controls.Add(Type:=msoControlButton) SubMenuItem.Caption = Caption SubMenuItem.OnAction = PositionOrMacro If FaceId <> "" Then SubMenuItem.FaceId = FaceId If Divider Then SubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop
End Sub
Bonsoir,
Vraiment personne pour m'aider...?
SVP.... Lionel
"Lionel" <liocanou@wanadoo.fr> a écrit dans le message de
news:4b6414a1$0$17503$ba4acef3@news.orange.fr...
Bonjour,
J'avais recuperé un module permettant de creer un menu supplementaire dans
excel. Or ca semble ne pas fonctionner sur excel 2007 alors que tout
fonctionnait a merveilles sur 2000
Quelles sont les parties incompatibles ou tout le code est a supprimer?
Merci du temps pris a m'aider
Cordialement .
Lionel
voici le code
Sub CreateMenu()
Application.ScreenUpdating = False
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
Dim feuille As String
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the menus aren't duplicated
feuille = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("MenuSheet").Select
[i1].Value = 1
Call DeleteMenu
Sheets("MenuSheet").Select
[i1].Value = 0
Application.ScreenUpdating = False
Sheets(feuille).Select
' Initialize the row counter
Row = 2
' Add the menus, menu items and submenu items using
' data stored on MenuSheet
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem > MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem > MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item
Set SubMenuItem > MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
"Lionel" a écrit dans le message de news:4b6414a1$0$17503$
Bonjour,
J'avais recuperé un module permettant de creer un menu supplementaire dans excel. Or ca semble ne pas fonctionner sur excel 2007 alors que tout fonctionnait a merveilles sur 2000 Quelles sont les parties incompatibles ou tout le code est a supprimer? Merci du temps pris a m'aider Cordialement . Lionel voici le code Sub CreateMenu() Application.ScreenUpdating = False ' This sub should be executed when the workbook is opened. ' NOTE: There is no error handling in this subroutine Dim feuille As String Dim MenuSheet As Worksheet Dim MenuObject As CommandBarPopup Dim MenuItem As Object Dim SubMenuItem As CommandBarButton Dim Row As Integer Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Location for menu data Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Make sure the menus aren't duplicated feuille = ActiveSheet.Name Application.ScreenUpdating = False Sheets("MenuSheet").Select [i1].Value = 1 Call DeleteMenu Sheets("MenuSheet").Select [i1].Value = 0 Application.ScreenUpdating = False Sheets(feuille).Select ' Initialize the row counter Row = 2 ' Add the menus, menu items and submenu items using ' data stored on MenuSheet Do Until IsEmpty(MenuSheet.Cells(Row, 1)) With MenuSheet MenuLevel = .Cells(Row, 1) Caption = .Cells(Row, 2) PositionOrMacro = .Cells(Row, 3) Divider = .Cells(Row, 4) FaceId = .Cells(Row, 5) NextLevel = .Cells(Row + 1, 1) End With Select Case MenuLevel Case 1 ' A Menu ' Add the top-level menu to the Worksheet CommandBar Set MenuObject = Application.CommandBars(1). _ Controls.Add(Type:=msoControlPopup, _ Before:=PositionOrMacro, _ Temporary:=True) MenuObject.Caption = Caption
Case 2 ' A Menu Item If NextLevel = 3 Then Set MenuItem > MenuObject.Controls.Add(Type:=msoControlPopup) Else Set MenuItem > MenuObject.Controls.Add(Type:=msoControlButton) MenuItem.OnAction = PositionOrMacro End If MenuItem.Caption = Caption If FaceId <> "" Then MenuItem.FaceId = FaceId If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item Set SubMenuItem > MenuItem.Controls.Add(Type:=msoControlButton) SubMenuItem.Caption = Caption SubMenuItem.OnAction = PositionOrMacro If FaceId <> "" Then SubMenuItem.FaceId = FaceId If Divider Then SubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop