bonjour a tous

je vous propose aujourd'hui un command barre flottante pour office 2007 et plus

en effet c'est une particularité qui a disparue depuis 2007
alors pour remédier a ca un petit code bien sympa pour avoir une barre d'outil avec les bouton de son choix dans le sheets
je lui ai donné un aspect un peu comme aéro(vista/seven)
je lui ai donné aussi la possibilité de son sens (vertical ou horizontal)

collez ce code dans un module et essayez
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
 
Option Explicit
Option Base 1
Const horizontal = "horizontal"
Const vertical = "vertical"
Dim nsh As Variant
Sub affiche_la_barre_verticalement()
    barro , , , vertical  'les argument sont facultatifs (lenom du sheets(feuille active par deafut),le top ,le left tout les deux etant a 10 par defaut
End Sub
Sub affiche_la_barre_horizontalement()
    barro , , , horizontal  'les argument sont facultatifs (lenom du sheets(feuille active par deafut),le top ,le left tout les deux etant a 10 par defaut
End Sub
Function barro(Optional sh As String, Optional letop As Long = 5, Optional leleft As Long = 0, Optional sens As Variant = horizontal)
    nsh = IIf(sh = "", ActiveSheet.Name, sh)
    Application.ScreenUpdating = False
    effacebaro
    Dim tableau(), elements, i As Long, gauche, tbar As CommandBar, groupecontrol, large
    Dim dim1, dim2, separ, im
    '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, 43, 1612, 220, 124, 51)
    dim1 = UBound(elements) * 25    'on applique cette operation
    dim2 = 25
    If leleft = 0 Then leleft = (Application.Width - (UBound(elements) * 25)) / 2
    Set tbar = Application.CommandBars.Add(Name:="BarreTemp")
    If sh = "" Then sh = ActiveSheet.Name
    With Sheets(sh)
        'on construit le fond avec un shape rectangulaireau coin arrondi
        If sens = horizontal Then
            .Shapes.AddShape(5, leleft, letop, dim1, dim2).Name = "fondmenu"
        Else
            leleft = Application.Width - 80
            .Shapes.AddShape(5, leleft, letop, dim2, dim1).Name = "fondmenu"
        End If
        With .Shapes("fondmenu")
            .Fill.ForeColor.RGB = RGB(200, 255, 255)    'on y applique une couleur
            .Line.Visible = True    ' on autorise le detourage de la forme
            .Line.ForeColor.RGB = RGB(200, 255, 200)    'on applique une couleur au detourage
            .Line.Weight = 1
            .Adjustments(1) = 0.5
            .Fill.OneColorGradient Style:=msoGradientFromCenter, Variant:=1, Degree:=0.1
            .Fill.Transparency = 0.8
        End With
        For i = 1 To UBound(elements)
            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
                'on le place dans le fond(barrette du menu )en fonction du sens (horizontal ou vertical)
                If sens = horizontal Then
                    .Top = letop + 5: .Left = leleft + separ + 8
                Else
                    .Top = letop + separ + 8: .Left = leleft + 5
                End If
                .Width = .Width + 2: .Height = .Height + 2
                'on le nomme
                .Name = "Bt" & elements(i)
                'on l'ajoute au tableau
                ReDim Preserve tableau(1 To i)
                tableau(i) = "Bt" & elements(i)
                'on regle la prochaine position (left/top selon le sens ) pour le prochain bouton
                separ = separ + 25
                .OnAction = "bouton_Clic2"    'on lui attribu la macro
                'on supprime la couleur (grise)du calque dur (image du bouton)
                .PictureFormat.TransparencyColor = 15790320
            End With
        Next
        ReDim Preserve tableau(i + 1)
        tableau(i + 1) = "fondmenu"
        'maintenant on groupe toute les image avec le fond pour pouvoir les deplacer en meme temps
        Set groupecontrol = .Shapes.Range(tableau).Group
        'on nomme le groupe.
        groupecontrol.Name = "Mon_menu_aero"
 
        For Each im In Sheets(sh).Shapes
            If Left(im.Name, 2) = "bt" Then im.PictureFormat.TransparencyColor = 15790320          ' on supprime la couleur grise autour des icons
        Next
    End With
    effacebaro
End Function
Sub bouton_clic2()
    Select Case Split(Application.Caller, "Bt")(1)
    Case 23, 32, 25, 18, 53, 123, 12, 210, 24, 45, 137, 331, 144, 249, 107, 43, 1612, 220, 124
        MsgBox Application.Caller
    Case 51
        Sheets(nsh).Shapes.Range("Mon_menu_aero").Delete
    End Select
End Sub
Sub effacebaro()
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
End Sub
qu'en pensez vous?

au plaisir