Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

affichage de menu CommandBar grisés

14 réponses
Avatar
francois45
Bonjour,
j'ai un problème d'affichage de menu, c'est la première fois que j'en fait
un tout seul et ça marche pas quelqu'un peut-il m'aider à résoudre le
problème d'affichage?
les 3 menus restent grisés ???
merci

voici ce que j'ai mis dans un module1

Public Menuligne1, MenuLigne2, MenuLigne3, SousMenu31, SousMenu32 As
CommandBarControl

Sub AnnuleMenu()
CommandBars(1).Reset
CommandBars(2).Reset
CommandBars(3).Reset



End Sub

Sub AjoutMenu()
' Réinitialise la barre de commandes "Menu Barre"

CommandBars(1).Reset
' Ajout du menu "OLERON" à la fin de la barre "Menu Barre"
' et de ses articles et sous-articles
Set Menu = CommandBars(1).Controls.Add(Type:=msoControlPopup)
Menu.Caption = "&OLERON"


Set Menuligne1 = Menu.Controls.Add(Type:=msoControlButton)
Menuligne1.Caption = "MISE EN FORME"
Menuligne1.OnAction = "MISENFORME" 'macro associée
Menuligne1.Enabled = False
Menuligne1.FaceId = 343

Set MenuLigne2 = Menu.Controls.Add(Type:=msoControlButton)
MenuLigne2.Caption = "REMISE A ZERO"
MenuLigne2.OnAction = "efface" 'nom de la macro associée
MenuLigne2.Enabled = False
MenuLigne2.FaceId = 343

Set MenuLigne3 = Menu.Controls.Add(Type:=msoControlPopup)
MenuLigne3.Caption = "IMPRIME"

Set SousMenu31 = MenuLigne3.Controls.Add(Type:=msoControlButton)
SousMenu31.Caption = "format A3"
SousMenu31.OnAction = "imprimea3" 'nom à donner a la macro
SousMenu31.FaceId = 210

Set SousMenu32 = MenuLigne3.Controls.Add(Type:=msoControlButton)
SousMenu32.Caption = "format A4"
SousMenu32.OnAction = "imprimea4" 'nom a donner a la macro
SousMenu32.FaceId = 211

MenuLigne3.Enabled = False
' ----------- Ajout d'une ligne de séparation avant l'article 3
MenuLigne3.BeginGroup = True

End Sub

dans le workbook j'ai mis ceci

Dim modif As Boolean
'déclaration de la macro modif


Private Sub Workbook_Open()
AjoutMenu
Sheets("OLERON").Activate

modif = False
'dès qu'il y a modif

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' If modif = True Then
' Sheets("Saisie").Range("p1").Value = "Modif le " & Format(Date, _
'"dd/mm/yyyy") & " " & Format(Time, "hh:mm")
'c'est là que la date de modif s'affiche
'End If
AnnuleMenu 'important pour que le menu apparaisse que dans ce document
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modif = True
End Sub


sur l'onglet OLERON ceci

Private Sub Worksheet_Activate()
Menuligne1.Enabled = True
MenuLigne2.Enabled = True
MenuLigne3.Enabled = True
Range("a3").Activate
End Sub

4 réponses

1 2
Avatar
MichDenis
| La présence de On error resume next dans cette procédure, c'était
| que la procédure se plante,

cette ligne devrait se lire ainsi :

La présence de On error resume next dans cette procédure, c'était
pour empêcher que la procédure se plante...
Avatar
francois45
re bonsoir michel,

je n'ai pas tout compris sur On error resume next mais apparemment avec une
commande contenant des sous menus il n'est pas possible d'afficher de petits
icones ...(si je résume) ce n'est pas grave c'était juste pour la vue.

je te remercie beaucoup de ton aide car sans toi j'aurais piétiné avec mes
menus qui ne s'affichaient pas, j'essayais de bidouiller sans vraiment
comprendre ce que faisais.
super la procédure pour aller chercher les FaceId je la garde précieusement
tout comme ta façon de mettre des menus, ça me resservira, c'est sure !!

je n'ai pas envoyé la procédure de mise en page pour que tu la corrige mais
la dernière fois que j'avais fait un programme, et en le soumettant (il
fallait supprimer des lignes en fonction de plusieurs critères soit une
centaine), ce que j'avais écrit critère par critère (400 ou 500 lignes) pour
supprimer chaques lignes sur ma feuille excel avait été résumé en quelques
lignes (une 30aine) et je trouve ça impressionnant, la procédure était très
courte et hyper rapide...j'admire, c'est un art, on progresse pas à pas,
mais même avec un bon bouquin le langage VBA reste assez obscure pour les
non initiés comme moi, même avec de la bonne volonté et de l'obstination,
ce qui parrait évident à certains ne saute pas du tout aux yeux aux
autres...

encore merci,

François.
Avatar
MichDenis
Je me suis laissé tenter par l'exercice :

J'ai scindé ta procédure en 3, elle est plus lisible.

Tu n'as qu'à lancer la procédure "Mise en forme "

Tu devrais avoir un certain nombre de retouches à faire !
L'enregistreur de macro génère beaucoup de code inutile
et à certains moments, ce n'est pas évident de déceler
ce que l'auteur désire faire via le code affiché.

Disons que c'est un guide!

'----------------------------------------------
Sub Mise_En_Page()
Application.ScreenUpdating = False
Columns.AutoFit
Range("E:I").Delete Shift:=xlToLeft
Range("H3") = "Réel"
Columns("K:K").Insert Shift:=xlToRight
Range("K3") = "Réel"
Columns("M:M").Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
Range("V:V").Delete Shift:=xlToLeft
Range("A:A,G:L,V:V").Font.Bold = True

With Cells
.RowHeight = 14
End With

' Impression Forme A3
Call Mise_en_Page_A3

Range("A:A").ColumnWidth = 6.71
Range("B:B").ColumnWidth = 6.57
Range("B:B").ColumnWidth = 4.57
Range("O:O").ColumnWidth = 25.86

With Range("A2:V3").Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
With Range("A2:A3")
.Merge
.HorizontalAlignment = xlCenter
.Copy
End With
Range("M2").PasteSpecial Paste:=xlPasteFormats
Range("V2").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

'Largeur des colonnes
Range("A:A,V:V").ColumnWidth = 6.3
Columns("B:B").ColumnWidth = 4.71
Range("C:C,L:L,Q:Q,S:S").ColumnWidth = 4.43
Range("D:D").ColumnWidth = 3.57
Range("E:F").ColumnWidth = 9.57
Range("G:K").ColumnWidth = 4.86
Range("M:M").ColumnWidth = 7.57
Range("N:N").ColumnWidth = 6
Range("O:O").ColumnWidth = 38.14
Range("P:P,R:R").ColumnWidth = 4.71
Range("T:T,U:U").ColumnWidth = 4.57

Range("L:L,S:S").HorizontalAlignment = xlCenter
Range("N2") = "Compo"
With Range("G2:L2")
.Merge
.HorizontalAlignment = xlCenter
End With
Range("O2").HorizontalAlignment = xlCenter
Range("A2:V3").Font.Bold = True
'ligne et police
With Cells
With .Font
.Name = "Arial"
.Size = 8
End With
.RowHeight = 9.75
End With
' Impression Forme A4
Call Mise_en_Page_A4
Application.ScreenUpdating = True
End Sub

'----------------------------------------------
Sub Mise_en_Page_A4()
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "page &P sur &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.118110236220472)
.RightMargin = Application.InchesToPoints(0.118110236220472)
.TopMargin = Application.InchesToPoints(0.118110236220472)
.BottomMargin = Application.InchesToPoints(0.354330708661417)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.196850393700787)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
'à remettre ' .PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub

'----------------------------------------------
Sub Mise_en_Page_A3()
' mise en forme a3
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "page &P sur &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.118110236220472)
.RightMargin = Application.InchesToPoints(0.118110236220472)
.TopMargin = Application.InchesToPoints(0.118110236220472)
.BottomMargin = Application.InchesToPoints(0.236220472440945)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
'a remettre ' .PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
'----------------------------------------------
Avatar
francois45
en fait c'était Youki qui m'avait dépanné et ce que j'avais écrit en 903
ligne était résumé en 9 lignes...!!! chapeau !!

encore merci

François.
1 2