Discussion :

[Nicopilami]

Bonjour, je crée souvant des barres de menu personnalisées, mais celles ci se créent dans l'onglet AddIn du "ribbon". Savez-vous s'il est possible de créer une vraie barre d'outil "indépendante", de telle facon à ce qu'elle soit visible meme si on cache le "ribbon" ?

Merci d'avance
Nico

[Daniel.C]

Bonjour,

Je ne suis pas un pro des barres d'outils. J'ai juste noté cet exemple, à mettre dans un module. La créatiion est provoquée par la macro "CréationMenu" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Act1()
    MsgBox "toto"
End Sub
Sub Act2()
    MsgBox "titi"
End Sub
Sub Act3()
    MsgBox "tutu"
End Sub
Sub CreationMenu()
    Dim MaBarre As CommandBar
    Dim i As Integer
    On Error Resume Next
    Application.CommandBars("DblClic").Delete
    With ActiveSheet.Pictures.Insert("C:\Users\Daniel\Pictures\scandale.jpg") '<-- insertion de l'image
        .Name = "Pic1" '<-- attribution d'un nom à l'image
        .Copy '<-- copie de l'image dans le presse-papier
        .Delete
    End With
    Set MaBarre = Application.CommandBars _
        .Add(Name:="DblClic", Position:=msoBarPopup)
    With MaBarre
        Set ctrl = .Controls.Add(Type:=msoControlButton, ID:=126)
        ctrl.PasteFace
        ctrl.OnAction = "Act1"
        ctrl.Caption = "toto"
        Set ctrl = .Controls.Add(Type:=msoControlButton)
        ctrl.OnAction = "Act2"
        ctrl.Caption = "titi"
        Set ctrl = .Controls.Add(Type:=msoControlButton, ID:=126)
        ctrl.OnAction = "Act3"
        ctrl.Caption = "tutu"
    End With
    MaBarre.ShowPopup
End Sub

[patricktoulon]

bonjour

la reponse est non pas avec 2007 le "msoBarFloating" ne sert plus a rien

les nouvelles barres d'outils vont directement dans l'onglet complement

danielc t'a donné la facon avec une commandbars (popup,menu contextuel)

tu peux le faire avec un userform voir meme une forme automatique aussi


au plaisir

[Nicopilami]

ok, merci à tous, je me débrouillerai avec ca
++
Nico

[patricktoulon]

re
voila un exemple tres simple avec l'utilisation de shapes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Dim sh
Sub menu()
    Dim ltop As Long, llarge As Long, leheight As Long, tableau(5)
    ltop = 10
    llarge = 100
    leheight = 120
    With Sheets(1)
'on construit le fond
        .Shapes.AddShape(5, ActiveCell.Left, ActiveCell.Top, llarge, leheight).Name = "fondmenu"
        With .Shapes("fondmenu")
            .Fill.ForeColor.RGB = RGB(0, 50, 255)
            .Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, Degree:=0.1
        End With
'on ajoute les boutons
        For i = 1 To 4
                      .Shapes.AddShape(5, ActiveCell.Left + 6, ActiveCell.Top + lheight + 8, llarge - 10, 20).Name = "fondbouton" & i
            lheight = 25 * i
            With .Shapes("fondbouton" & i)
                .Adjustments(1) = 0.5
                .Fill.ForeColor.RGB = vbRed
                .Fill.OneColorGradient Style:=msoGradientFromCenter, Variant:=1, Degree:=0.1
                .TextFrame.Characters.Text = "Bouton" & i
    .OnAction = "bouton_Clic"
                tableau(i) = "fondbouton" & i
            End With
        Next
        tableau(5) = "fondmenu"
        Set sh = .Shapes.Range(tableau).Group
        'Renomme le groupe.
        sh.Name = "Mon_menu"
    End With
End Sub
Sub bouton_Clic()
MsgBox "coucou c'est moi le bouton " & Application.Caller
'dans cette fonction tu pourrais utiliser un select case pour chaque boutonsen te servant de application.caller pour determiner le case
End Sub

au plaisir

[Nicopilami]

Excellent ta barre de menu en "shapes" !!
bon par contre je voyais à l'origine plus une barre d'outil standard, mais en "flottant", un peu comme dans les versions précédentes d'Office...

Merci quand même pour l'exemple

++
Nico

[patricktoulon]

bonjour

ya pas de souci donne moi un cliché d'ecran ou se trouve ta barre flottante

je te la reprodui pratiquement a l'identique

au plaisir

[Nicopilami]

Voilà monsieur, je voudrais la même barre avec des grosses icônes, aucune incidence que ce soit en vertical ou horizontal

merciiiiiii :-)

[patricktoulon]

re
pas de souci

elle n'a pas l'air trop compliqué

laisse moi une journée je te fait ca

il te restera a affecter les macros a chaque boutons comme je te l'ai dis dans un select case

a plus
au plaisir

[patricktoulon]

re
allez comme ca un premier jet sur cette idée

essaie ca et dis moi ce que tu en pense
j'ai beaucoup commenté le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Option Base 1
Sub newmenu()
    Dim tableau(20), sh, elements, i As Long
    'ici dans l'array chaque chifre coresponde au ID exactes d'office des iconnes representant tes boutons
    elements = Array(23, 32, 25, 18, 53, 123, 12, 210, 24, 45, 137, 331, 144, 249, 107, 43, 639, 220, 124)
    'Supprime la barre d'outils temporaire si elle existe.
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
    On Error GoTo 0
    With Sheets(1)
        'on construit le fond avec un shape rectangulaire
        .Shapes.AddShape(1, ActiveCell.Left, ActiveCell.Top, 400, 25).Name = "fondmenu"
        .Shapes("fondmenu").Fill.ForeColor.RGB = RGB(240, 255, 255)
        'on construit un command barstemporaire pour y inserer les bouton dont on va copier la face (par le ID)
        Set tBar = Application.CommandBars.Add(Name:="BarreTemp")
        For i = 1 To 19
            'Crée un nouveau bouton dans la barre d'outils
            With tBar.Controls.Add(Type:=msoControlButton)
                'Ajoute un FaceID
                .FaceId = elements(i)    'on choisi chaque element de l'array elements pour la face des boutons
                .CopyFace    'Copie le FaceID(l'image du bouton de la command barrs temporaire )
            End With
                       .Paste 'Effectue le collage dans la feuille de l'image
                        With .Shapes(.Shapes.Count)
                'on le place dans le fond
                .Top = Sheets(1).Shapes("fondmenu").Top + 5
                .Left = Sheets(1).Shapes("fondmenu").Left + gauche + 8
                'on le nomme
                .Name = "fondbouton" & i
                'on l'ajoute au tableau
                tableau(i) = "fondbouton" & i
                'on regle la prochaine position left pour le prochain bouton
                gauche = gauche + 20
                .OnAction = "bouton_Clic" 'on lui attribu la macro
            End With
        Next
        'on ajoute le fond au tableau
        tableau(20) = "fondmenu"
        'maintenant on groupe toute les image avec le font pour pouvoir les deplacer en meme temps
        Set sh = .Shapes.Range(tableau).Group
        'on nomme le groupe.
        sh.Name = "Mon_menu"
    End With
End Sub
Sub bouton_Clic()
    MsgBox "coucou c'est moi le bouton " & Application.Caller
    'dans cette fonction tu pourrais utiliser un select case pour chaque boutonsen te servant de application.caller pour determiner le case
End Sub

voili voilou
j'attend tes commentaires et tes suggestions
au plaisir

[Nicopilami]

EXCELLENT !!!
Par contre le fond des images est gris
Mais où vas-tu chercher tout ca ?

Bon en revanche...
Pendant ce temps à Vera Cruz ...
j'ai trouvé le moyen de customiser le ribbon à l'aide de l'editeur gratuit CustomUI, donc j'avais utilisé ca come solution alternative.

Je garde donc ta solution bien au chaud

Merci encore
Nico

[patricktoulon]

Bonjour le tacheté


Voila maintenant que mr rechigne pour un peu de gris alors on va te l'enlever

J'ai ajouté le bouton de fermeture de la barre.

Tiens copie ce code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Option Base 1
Dim sh
Sub newbarre_flottante()
    Dim tableau(21), sh, elements, i As Long, gauche
    'ici dans l'array chaque chiffre correspond au ID exactes d'office des icons representants tes boutons
    elements = Array(23, 32, 25, 18, 53, 123, 12, 210, 24, 45, 137, 331, 144, 249, 107, 43, 639, 220, 124, 51)
    'Supprime la barre d'outils temporaire si elle existe.
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
    On Error GoTo 0
    With Sheets(1)
        'on construit le fond avec un shape rectangulaire
        .Shapes.AddShape(1, ActiveCell.Left, ActiveCell.Top, 410, 25).Name = "fondmenu"
        .Shapes("fondmenu").Fill.ForeColor.RGB = (16767937)
        .Shapes("fondmenu").Line.Visible = False
        'on construit un commandbars temporaire pour y inserer les boutons dont on va copier la face (par le ID)
        Set tBar = Application.CommandBars.Add(Name:="BarreTemp")
        For i = 1 To 20
            'Crée un nouveau bouton dans la barre d'outils
            With tBar.Controls.Add(Type:=msoControlButton)
                'Ajoute un FaceID
                .FaceId = elements(i)    'on choisi chaque element de l'array elements pour la face des boutons
                .CopyFace    'Copie le FaceID(l'image du bouton de la commandbars temporaire )
            End With
            .Paste    'Effectue le collage dans la feuille de l'image
            With .Shapes(.Shapes.Count) 'avec la derniere image insererée
                .Fill.Transparency = 1    ' on rend completement transparent le calque alpha de l'image .  de o a 1: 1 etant completement transparent
                .PictureFormat.TransparencyColor = 15790320    'on supprime la couleur (grise)du calque dur (image du bouton)
                'on le place dans le fond(barrette du menu )
                .Top = Sheets(1).Shapes("fondmenu").Top + 5
                .Left = Sheets(1).Shapes("fondmenu").Left + gauche + 8
                'on le nomme
                .Name = "fondbouton" & i
                'on l'ajoute au tableau
                tableau(i) = "fondbouton" & i
                'on regle la prochaine position left pour le prochain bouton
                gauche = gauche + 20
                .OnAction = "bouton_Clic"    'on lui attribu la macro
            End With
            'la couleur de fond (gris) du bouton 1 est legerement differente des autres alors
            Sheets(1).Shapes("fondbouton1").PictureFormat.TransparencyColor = 16773091
 
        Next
        'on ajoute le fond au tableau
        tableau(21) = "fondmenu"
        'maintenant on groupe toute les image avec le font pour pouvoir les deplacer en meme temps
        Set sh = .Shapes.Range(tableau).Group
        'on nomme le groupe.
        sh.Name = "Mon_menu"
    End With
    Application.CommandBars("BarreTemp").Delete
End Sub
Sub bouton_Clic()
    If Application.Caller <> "fondbouton20" Then MsgBox "coucou c'est moi le bouton " & Application.Caller
 
    'dans cette fonction tu pourrais utiliser un select case pour chaque boutons en te servant de application.caller pour determiner le case
 
Select Case Application.Caller
 
    Case "fondbouton1"
 
    Case "fondbouton2"
 
    Case "fondbouton3"
 
    Case "fondbouton4"
 
    Case "fondbouton5"
 
    Case "fondbouton6"
 
    Case "fondbouton7"
 
    Case "fondbouton8"
 
    Case "fondbouton9"
 
    Case "fondbouton10"
 
    Case "fondbouton11"
 
    Case "fondbouton12"
'ect..... jusqu'a 20
 
  Case "fondbouton20"
       MsgBox "je suis le bouton de fermeture de la barre flottante"
        Sheets(1).Shapes.Range("mon_menu").Delete ' si tu veux faire disparaitre le menu apres cliquer sur un bouton
End Select
    End Sub

c!bo!la!vie...non????....

Allez dit moi ce que tu en penses ? Ou suggestions ?

Ensuite tu a dis au départ je te cite :

Bonjour, je crée souvant des barres de menu personnalisées, mais celles ci se créent dans l'onglet AddIn du "ribbon". Savez-vous s'il est possible de créer une vraie barre d'outil "indépendante", de telle facon à ce qu'elle soit visible meme si on cache le "ribbon" ?
Merci d'avance
Nico
__________________

Donc la solution que tu as adopté ne correspond pas a ta demande initiale.

D'autant plus que custom ui editor que je connais très bien te modifie les fichiers excel 2007 et plus, mais si ton fichier est utilisé sur une autre bécane équipée d'une version antérieure a 2007 et bien c'est choux blanc.

A méditer


Au plaisir

[patricktoulon]

re
devant l'inconstance de tes intentions

je me suis vu obligé de te faire un exemplaire qui te fait les deux

dans la commandbars tu a l'icone representant une main
ce bouton te sert a transformer cette barre en commadbar fixe dans le ruban(onglet complement ) ou en commandbars "floating" et vice et versa

je m'amuse bien avec ton idée
colle ce code et rien que ca dans un module et lance la ,sub "newbarre_flottante"amuse toi avec la main autant que tu veux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
 
Option Explicit
Option Base 1
Dim sh
Public modes As String
Sub newbarre_flottante()
    Application.DisplayFullScreen = True
    Application.ScreenUpdating = False
    modes = "floting"
    Dim tableau(21), sh, elements, i As Long, gauche, tbar As CommandBar
    'ici dans l'array chaque chiffre correspond au ID exactes d'office des icons representants tes boutons
    elements = Array(23, 32, 25, 18, 53, 123, 12, 210, 24, 45, 137, 331, 144, 249, 107, 43, 1612, 220, 124, 51)
    'Supprime la barre d'outils temporaire si elle existe.
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
    On Error GoTo 0
    With Sheets(1)
        'on construit le fond avec un shape rectangulaire
        .Shapes.AddShape(1, ActiveCell.Left, ActiveCell.Top, 410, 25).Name = "fondmenu"
        .Shapes("fondmenu").Fill.ForeColor.RGB = (16767937)
        .Shapes("fondmenu").Line.Visible = False
        'on construit un commandbars temporaire pour y inserer les boutons dont on va copier la face (par le ID)
        Set tbar = Application.CommandBars.Add(Name:="BarreTemp")
        For i = 1 To 20
            'Crée un nouveau bouton dans la barre d'outils
            With tbar.Controls.Add(Type:=msoControlButton)
                'Ajoute un FaceID
                .FaceId = elements(i)    'on choisi chaque element de l'array elements pour la face des boutons
                .CopyFace    'Copie le FaceID(l'image du bouton de la commandbars temporaire )
            End With
            .Paste    'Effectue le collage dans la feuille de l'image
            With .Shapes(.Shapes.Count)    'avec la derniere image insererée
                .Fill.Transparency = 1    ' on rend completement transparent le calque alpha de l'image .  de o a 1: 1 etant completement transparent
                .PictureFormat.TransparencyColor = 15790320    'on supprime la couleur (grise)du calque dur (image du bouton)
                'on le place dans le fond(barrette du menu )
                .Top = Sheets(1).Shapes("fondmenu").Top + 5
                .Left = Sheets(1).Shapes("fondmenu").Left + gauche + 8
                'on le nomme
                .Name = "bouton" & i
                'on l'ajoute au tableau
                tableau(i) = "bouton" & i
                'on regle la prochaine position left pour le prochain bouton
                gauche = gauche + 20
                .OnAction = "bouton_Clic"    'on lui attribu la macro
                .PictureFormat.TransparencyColor = 15790320    'on supprime la couleur (grise)du calque dur (image du bouton)
 
            End With
            'la couleur de fond (gris) du bouton 1 est legerement differente des autres alors
            Sheets(1).Shapes("bouton1").PictureFormat.TransparencyColor = 16773091
 
        Next
        'on ajoute le fond au tableau
        tableau(21) = "fondmenu"
        'maintenant on groupe toute les image avec le font pour pouvoir les deplacer en meme temps
        Set sh = .Shapes.Range(tableau).Group
        'on nomme le groupe.
        sh.Name = "Mon_menu"
    End With
    Application.CommandBars("BarreTemp").Delete
End Sub
Sub bouton_Clic()
Dim bouton As String
    If modes = "floting" Then    'si on est en mode floating
        bouton = Application.Caller
        'ou alors en mode commandbars
    ElseIf modes = "barretop" Then bouton = CommandBars.ActionControl.Tag    ' Application.CommandBars.ActionControl.Control.Tag
    End If
 
    If bouton <> "bouton20" Then MsgBox "coucou c'est moi le bouton " & bouton
 
    'dans cette fonction tu pourrais utiliser un select case pour chaque boutonsen te servant de application.caller pour determiner le case
    Select Case bouton
 
    Case "bouton1"
    Case "bouton2"
    Case "bouton3"
    Case "bouton4"
    Case "bouton5"
    Case "bouton6"
    Case "bouton7"
    Case "bouton8"
    Case "bouton9"
    Case "bouton10"
    Case "bouton11"
    Case "bouton12"
        'ect..... jusqu'a 20
    Case "bouton20"
        If modes = "barretop" Then
            newbarre_flottante
            effacebarre
        ElseIf modes = "floting" Then
            Sheets(1).Shapes.Range("mon_menu").Delete ' si tu veux faire disparaitre le menu apres cliquer sur un bouton
            rebarretop
        End If
    End Select
End Sub
Sub rebarretop()
    Application.DisplayFullScreen = False
    effacebarre
    modes = "barretop"
    Dim CmdBar As CommandBar, MonBouton As CommandBarButton, elements, i As Long
    elements = Array(23, 32, 25, 18, 53, 123, 12, 210, 24, 45, 137, 331, 144, 249, 107, 43, 1612, 220, 124, 51)
    'Création de la barre d'outils nommée 'MaBarrePerso'
    Set CmdBar = Application.CommandBars.Add(Name:="MaBarretop", Position:=msoBarTop, Temporary:=True)
    For i = 1 To 20
        'Ajout de 3 boutons dans la barre d'outils
        Set MonBouton = CmdBar.Controls.Add(Type:=msoControlButton)
        With MonBouton
            .Style = msoButtonIconAndWrapCaption    'defini le style de bouton 'icon avec texte
            .FaceId = elements(i)    'Définit "l'image" qui va s'afficher sur le bouton
            .Caption = "Bout " & i    'defini la caption du bouton
            .OnAction = "bouton_Clic"    'Définit quelle macro est associée au bouton,Cette macro sera lancée à chaque fois que vous cliquez sur le bouton.
            .Tag = "bouton" & i    'defini le tag du bouton
            If i = 2 Or i = 5 Or i = 8 Then .BeginGroup = True
        End With
    Next
    CmdBar.Visible = True
End Sub
Sub effacebarre()
    On Error Resume Next
    Application.CommandBars("Mabarretop").Delete
End Sub

au plaisir