affichage de menu CommandBar grisés

Bonjour,

lorsque tu emploie .enabledúlse
il est normal qu'il soit grisé
il faudrait .enabled=true


Nota:
Lorsque tu écris ceci:
>Public Menuligne1, MenuLigne2, MenuLigne3, SousMenu31, SousMenu32 As
>CommandBarControl

Seul le SousMenu32 est typé As CommandBarControl
les autres n'ayant pas cette spécification sont en Variant.

@+

--
lSteph

francois45 a écrit :

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

Bonjour François,

Voici ta procédure sous une autre présentation :

La propriété "Enabled" n'a pas à être défini au moment de la
création du menu sauf si tu veux explicitement désactivé le
bouton lors de sa création.

'-------------------------------------------
Sub AjoutMenu()

Dim NewMenu As CommandBarControl

With Application.CommandBars("Worksheet menu bar")
.Reset
'Ajout d'un item après le dernier item du menu "?"
Set NewMenu = .Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
NewMenu.Caption = "&OLERON"
End With

With NewMenu
'Ajout bouton1 - premier niveau
With .Controls.Add(msoControlButton)
.Caption = "MISE EN FORME"
.OnAction = "MISENFORME" 'macro associée
.FaceId = 343
End With
'Ajout bouton2 - premier niveau
With .Controls.Add(msoControlButton)
.Caption = "REMISE A ZERO"
.OnAction = "efface" 'nom de la macro associée
.FaceId = 343
End With
'Ajout bouton3 - premier niveau
With .Controls.Add(msoControlPopup)
.Caption = "Denis"
'Ajout Sous-menu1 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A3"
.OnAction = "imprimea3" 'nom à donner a la macro
.FaceId = 210
End With
'Ajout Sous-menu2 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A4"
.OnAction = "imprimea4" 'nom a donner a la macro
.FaceId = 211
End With
End With
End With

End Sub
'-------------------------------------------



"francois45" <pichalou@free.fr> a écrit dans le message de groupe de discussion :
uvKt#tQtJHA.1236@TK2MSFTNGP02.phx.gbl...
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

re bonjour,

la procedure fonctionne à merveille, c'est super, je vous remercie, c'était
de la récup que j'avais réadapté mais en ne connaissant pas le langage de
programation, difficile de trouver ce qui ne colle pas...!!

encore merci et bon week end à tous.

encore 3 questions :
au dessous de Caption = "IMPRIME peut on mettre .FaceId = 352 ?? ce
serait plus beau...

pour lancer une impression en paysage a3 puis dans une seconde macro la même
en A4 existe-il une procedure simple ?? l'imprimante gère les 2 et la mise
en page étant faite (le nombre de page déjà définit au format excel viewver,
je veux imprimer le même nombre de page en A3 et A4

'Ajout bouton3 - premier niveau
With .Controls.Add(msoControlPopup)
.Caption = "IMPRIME"
'ici peut on mettre .FaceId = 352 '?

'Ajout Sous-menu1 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A3"
.OnAction = "imprimea3" 'nom à donner a la macro
.FaceId = 4
End With
'Ajout Sous-menu2 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A4"
.OnAction = "imprimea4" 'nom a donner a la macro
.FaceId = 4
End With
End With
End With

françois.

bonjour

encore une question, pour faire apparaitre le menu uniquement dans le
fichier me servant de base y a t-il une solution ? car lorsque j'ouvre un
autre fichier les macro sont actives sur le deuxième fichier et en faisant
une mauvaise manip cela pourrait être gênant.

merci

| pour faire apparaitre le menu uniquement dans le fichier me servant de base


Je suppose que tu as mis le code de la création d'un item du menu dans
un module standard.

Dans le ThisWorkbook, copie ce qui suit :

Évidemment, tu devras adapter le nom "&OLERON" si tu
l'a changé dans la version finale.

'----------------------------------------------------
Private Sub Workbook_Activate()
On Error Resume Next
Application.CommandBars("Worksheet menu bar").Controls("&OLERON").Delete
Call AjoutMenu
End Sub
'----------------------------------------------------
Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CommandBars("Worksheet menu bar").Controls("&OLERON").Delete
End Sub
'----------------------------------------------------

Concernant les icônes, le choix est varié.

Tu peux sélectionner le no du faceid que tu désires
Voici une procédure élaborée par ChrisV pour lister les faceid
et leur icône dans une feuille de calcul

ça prend quand même quelques instants pour afficher le résultat.
'-------------------------------------------------------
Sub Liste_faceID()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim cbCtl As CommandBarControl
Dim cbBar As CommandBar
On Error Resume Next
Application.ScreenUpdating = False
Set cbBar = CommandBars.Add(Position:=msoBarFloating, _
MenuBar:úlse, temporary:=True)
Set cbCtl = cbBar.Controls.Add(Type:=msoControlButton, _
temporary:=True)
k = 1
Do While Err.Number = 0
For j = 1 To 10
i = i + 1
Application.StatusBar = "FaceID=" & CStr(i)
cbCtl.FaceId = i
cbCtl.CopyFace
If Err.Number <> 0 Then Exit For
ActiveSheet.Paste Cells(k, j + 1)
Cells(k, j).Value = i
Next j
k = k + 1
Loop
Application.StatusBar = False
cbBar.Delete
End Sub
'-------------------------------------------------------


Procédure pour imprimer toutes les feuilles sélectionnées
en mode "paysage" et format A3. Pour avoir un format A4,
Tu peux reprendre la même procédure mais en modifiant :
.PaperSize = xlPaperA4
'-------------------------------------------
Sub Imprimer_Paysage_A3()

Dim Sh As Worksheet
For Each Sh In ActiveWindow.SelectedSheets
With Sh
With .PageSetup
.PaperSize = xlPaperA3
.Orientation = xlLandscape
'Tu peux définir toute une pléade de propriétés
'Tu type un point à la ligne du dessous
'et un menu déroulant va apparaître avec la liste

End With
End With
Next
End Sub
'-------------------------------------------






"francois45" <pichalou@free.fr> a écrit dans le message de groupe de discussion :
ubYXjcUtJHA.1504@TK2MSFTNGP03.phx.gbl...
re bonjour,

la procedure fonctionne à merveille, c'est super, je vous remercie, c'était
de la récup que j'avais réadapté mais en ne connaissant pas le langage de
programation, difficile de trouver ce qui ne colle pas...!!

encore merci et bon week end à tous.

encore 3 questions :
au dessous de Caption = "IMPRIME peut on mettre .FaceId = 352 ?? ce
serait plus beau...

pour lancer une impression en paysage a3 puis dans une seconde macro la même
en A4 existe-il une procedure simple ?? l'imprimante gère les 2 et la mise
en page étant faite (le nombre de page déjà définit au format excel viewver,
je veux imprimer le même nombre de page en A3 et A4

'Ajout bouton3 - premier niveau
With .Controls.Add(msoControlPopup)
.Caption = "IMPRIME"
'ici peut on mettre .FaceId = 352 '?

'Ajout Sous-menu1 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A3"
.OnAction = "imprimea3" 'nom à donner a la macro
.FaceId = 4
End With
'Ajout Sous-menu2 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A4"
.OnAction = "imprimea4" 'nom a donner a la macro
.FaceId = 4
End With
End With
End With

françois.

merci de ton aide michel

çà c'est la mise en forme je suis sure que c'est trop long (je fais de
l'enregistrement simple...) y a t-il moyen de faire plus court ?

François



Sub MISENFORME()
'
' MISENFORME Macro
'

'
Cells.Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste


Cells.Select
Cells.EntireColumn.AutoFit
Columns("E:E").Select
Range("E2").Activate
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Range("F2").Activate
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Range("G2").Activate
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Range("H3").Activate
Selection.Insert Shift:=xlToRight
Range("H3").Select
ActiveCell.FormulaR1C1 = "Réel"
Columns("K:K").Select
Range("K3").Activate
Selection.Insert Shift:=xlToRight
Range("K3").Select
ActiveCell.FormulaR1C1 = "Réel"
Columns("M:M").Select
Range("M2").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
ActiveWindow.SmallScroll ToRight:
Columns("V:V").Select
Range("V2").Activate
Selection.Delete Shift:=xlToLeft
Columns("G:L").Select
Range("G3").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Columns("A:A").Select
Range("A2").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Columns("V:V").Select
Range("V2").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Cells.Select
Selection.RowHeight = 21.75
Selection.RowHeight = 18
Columns("A:V").Select
Range("A2").Activate
ActiveWindow.SmallScroll Down:=1
Columns("A:A").Select
Range("A2").Activate
Selection.Find(What:="", After:¬tiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:úlse).Activate
Range("A1:V1").Select
ActiveCell.SpecialCells(xlLastCell).Select
'lignes
Cells.Select
Selection.RowHeight = 14
Range("A1:V1").Select

'lignes
Cells.Select
Selection.RowHeight = 14
Range("A1:V1").Select

' mise en forme a3
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.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
'largeur col
Columns("A:A").ColumnWidth = 6.71
Columns("B:B").ColumnWidth = 6.57
Columns("B:B").ColumnWidth = 4.57
Columns("O:O").ColumnWidth = 25.86

Range("A2:V3").Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Range("A2:A3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Copy
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=4
Range("V2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Application.CutCopyMode = False
Columns("A:A").Select
Selection.ColumnWidth = 6.3
Columns("B:B").Select
Selection.ColumnWidth = 4.71
Columns("C:C").Select
Selection.ColumnWidth = 4.43
Columns("D:D").Select
Selection.ColumnWidth = 3.57
Columns("E:E").Select
Selection.ColumnWidth = 9.57
Columns("F:F").Select
Selection.ColumnWidth = 9.57
Columns("G:K").Select
Selection.ColumnWidth = 4.86
Columns("L:L").Select
Selection.ColumnWidth = 4.43
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("M:M").Select
Selection.ColumnWidth = 7.57
Columns("N:N").Select
Selection.ColumnWidth = 6
Columns("O:O").Select
Selection.ColumnWidth = 38.14
Columns("P:P").Select
Selection.ColumnWidth = 4.71
Columns("Q:Q").Select
Selection.ColumnWidth = 4.43
Columns("R:R").Select
Selection.ColumnWidth = 4.71
Columns("S:S").Select
Selection.ColumnWidth = 4.43
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("T:T").Select
Selection.ColumnWidth = 4.57
Columns("U:U").Select
Selection.ColumnWidth = 4.57
Columns("V:V").Select
Selection.ColumnWidth = 6.3
Range("N2").Select
ActiveCell.FormulaR1C1 = "Compo"
Range("O2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G2:L2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2:V3").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("A1").Select

'ligne et police
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.RowHeight = 9.75
Range("A1").Select


'marges
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.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 With


End Sub

'Ajout bouton3 - premier niveau
With .Controls.Add(msoControlPopup)
.Caption = "Denis"
.FaceId = 9983

'Ajout Sous-menu1 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A3"
.OnAction = "imprimea3" 'nom à donner a la macro
.FaceId = 210

le faceID 9983 efface les autres menus et je comprends pas pourquoi ??

L'objectif du forum est l'entraide... je veux bien te donner un coup de pouce,
mais je n'écrirai pas toutes les procédures de ton fichier...

Si tu as des questions précises, ça va ... besoin d'explication, OK...
au-delà de ça, tu vas devoir mettre la main à la pâte !

Dans la procédure que tu as soumise, il y a toute une section sur la mise
en page pour ton impression. Si tu le désires, tu fais ta mise en page en
appelant la commande du menu fichier du même nom, et tu crées ta
mise en page. Lorsque tout est fin prêt, avant de lancer l'impression,
enregistre ton fichier, Excel va enregistrer de lui-même tous les
paramètres que tu as définis pour cette feuille et la prochaine fois
que tu voudras l'imprimer, tu n'auras qu'à lancer l'impression.

Au besoin, tu peux créer différentes vues personnalisées de ta feuille
(créer une vue personnalisée - menu affichage).

Sur le sujet, il y a l'aide d'Excel, et la venue d'un bon bouquin aide aussi.

Qui sait, peut être que quelqu'un d'autre te donnera ce que tu demandes !








"francois45" <pichalou@free.fr> a écrit dans le message de groupe de discussion :
#PcIkCVtJHA.1492@TK2MSFTNGP03.phx.gbl...
merci de ton aide michel

çà c'est la mise en forme je suis sure que c'est trop long (je fais de
l'enregistrement simple...) y a t-il moyen de faire plus court ?

François



Sub MISENFORME()
'
' MISENFORME Macro
'

'
Cells.Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste


Cells.Select
Cells.EntireColumn.AutoFit
Columns("E:E").Select
Range("E2").Activate
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Range("F2").Activate
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Range("G2").Activate
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Range("H3").Activate
Selection.Insert Shift:=xlToRight
Range("H3").Select
ActiveCell.FormulaR1C1 = "Réel"
Columns("K:K").Select
Range("K3").Activate
Selection.Insert Shift:=xlToRight
Range("K3").Select
ActiveCell.FormulaR1C1 = "Réel"
Columns("M:M").Select
Range("M2").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
ActiveWindow.SmallScroll ToRight:
Columns("V:V").Select
Range("V2").Activate
Selection.Delete Shift:=xlToLeft
Columns("G:L").Select
Range("G3").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Columns("A:A").Select
Range("A2").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Columns("V:V").Select
Range("V2").Activate
Selection.Font.Bold = False
Selection.Font.Bold = True
Cells.Select
Selection.RowHeight = 21.75
Selection.RowHeight = 18
Columns("A:V").Select
Range("A2").Activate
ActiveWindow.SmallScroll Down:=1
Columns("A:A").Select
Range("A2").Activate
Selection.Find(What:="", After:¬tiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:úlse).Activate
Range("A1:V1").Select
ActiveCell.SpecialCells(xlLastCell).Select
'lignes
Cells.Select
Selection.RowHeight = 14
Range("A1:V1").Select

'lignes
Cells.Select
Selection.RowHeight = 14
Range("A1:V1").Select

' mise en forme a3
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.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
'largeur col
Columns("A:A").ColumnWidth = 6.71
Columns("B:B").ColumnWidth = 6.57
Columns("B:B").ColumnWidth = 4.57
Columns("O:O").ColumnWidth = 25.86

Range("A2:V3").Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Range("A2:A3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Copy
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=4
Range("V2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Application.CutCopyMode = False
Columns("A:A").Select
Selection.ColumnWidth = 6.3
Columns("B:B").Select
Selection.ColumnWidth = 4.71
Columns("C:C").Select
Selection.ColumnWidth = 4.43
Columns("D:D").Select
Selection.ColumnWidth = 3.57
Columns("E:E").Select
Selection.ColumnWidth = 9.57
Columns("F:F").Select
Selection.ColumnWidth = 9.57
Columns("G:K").Select
Selection.ColumnWidth = 4.86
Columns("L:L").Select
Selection.ColumnWidth = 4.43
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("M:M").Select
Selection.ColumnWidth = 7.57
Columns("N:N").Select
Selection.ColumnWidth = 6
Columns("O:O").Select
Selection.ColumnWidth = 38.14
Columns("P:P").Select
Selection.ColumnWidth = 4.71
Columns("Q:Q").Select
Selection.ColumnWidth = 4.43
Columns("R:R").Select
Selection.ColumnWidth = 4.71
Columns("S:S").Select
Selection.ColumnWidth = 4.43
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("T:T").Select
Selection.ColumnWidth = 4.57
Columns("U:U").Select
Selection.ColumnWidth = 4.57
Columns("V:V").Select
Selection.ColumnWidth = 6.3
Range("N2").Select
ActiveCell.FormulaR1C1 = "Compo"
Range("O2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G2:L2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2:V3").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("A1").Select

'ligne et police
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.RowHeight = 9.75
Range("A1").Select


'marges
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.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 With


End Sub

| With .Controls.Add(msoControlPopup)
| .Caption = "Denis"
| .FaceId = 9983

Attention, la propriété "FaceId" n'est pas disponible pour
tous les "sortes" de bouton. Dans ce cas précis, pour les
"MSOCONTROLPOPUP", la propriété n'existe pas.

Conséquence, cela fait planter la procédure, mais comme il
y a la ligne de commande "On error Resume next" au lancement
ce celle-ci, elle s'exécute complètement mais aussi erratiquement
à partir de cette commande.

La présence de On error resume next dans cette procédure, c'était
que la procédure se plante, si Excel essayait de supprimer "Oleron"
sans qu'elle n'existe dans le fichier.
'-------------------------------------
Private Sub Workbook_Activate()
On Error Resume Next
Application.CommandBars("Worksheet menu bar").Controls("&OLERON").Delete
Call AjoutMenu
End Sub
'-------------------------------------





"francois45" <pichalou@free.fr> a écrit dans le message de groupe de discussion :
O36AGMVtJHA.5112@TK2MSFTNGP03.phx.gbl...
'Ajout bouton3 - premier niveau
With .Controls.Add(msoControlPopup)
.Caption = "Denis"
.FaceId = 9983

'Ajout Sous-menu1 du bouton3
With .Controls.Add(Type:=msoControlButton)
.Caption = "format A3"
.OnAction = "imprimea3" 'nom à donner a la macro
.FaceId = 210

le faceID 9983 efface les autres menus et je comprends pas pourquoi ??