XL 2013 afficher les onglets du classeur dans menu clic droit

bobinut60 · 31 Décembre 2021

Bonjour,
je suis pas doué en excel mais je cherche une solution en VBA pour atteindre d'un clic droit les différents onglets du classeur actif (la ou je clique).
pourrais avoir votre aide svp?
merci

job75 · 31 Décembre 2021

Bonjour bobinut60,

Voyez le fichier joint et la macro dans ThisWorkbook :

VB:

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim s As Object
Cancel = True
For Each s In Me.Sheets
    UserForm1.ListBox1.AddItem s.Name
Next
UserForm1.Show 0 'non modal'
End Sub

A+

fanch55 · 31 Décembre 2021

Bonjour à tous
Dans chaque feuille, mettre le code ci-dessous :

VB:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    W_Brc Target, Cancel
End Sub

Puis dans un module le code ci-dessous ( 2 exemples )

VB:

Sub W_Brc(ByVal Target As Range, Cancel As Boolean) ' Worksheet_BeforeRightClick
Dim Sh      As Worksheet
Dim Control As Object
Dim Rbar    As CommandBar
Const Cb = "RightClick"
    Cancel = True
    On Error Resume Next: CommandBars(Cb).Delete: On Error GoTo 0
    Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
    With Rbar
        With .Controls.Add(msoControlPopup, , , .Controls.Count + 1, True)
            .Caption = "Activer feuille"
            For Each Sh In ThisWorkbook.Worksheets
                Select Case True
                Case Sh.Name = ActiveSheet.Name
                Case Sh.Type <> xlWorksheet
                Case Else
                    With .Controls.Add(msoControlButton, , , , True)
                        .Caption = Sh.Name
                        .FaceId = 1154
                        .OnAction = "Show_Tab"
                    End With
                End Select
            Next
        End With
         For Each Sh In ThisWorkbook.Worksheets
            Select Case True
            Case Sh.Name = ActiveSheet.Name
            Case Sh.Type <> xlWorksheet
            Case Else
                With .Controls.Add(msoControlButton, , , , True)
                    .Caption = Sh.Name
                    .FaceId = 634
                    .OnAction = "Show_Tab"
                End With
            End Select
        Next
        Copy_Controls Rbar, IIf(ActiveCell.ListObject Is Nothing, "Cell", "List Range Popup")
        .ShowPopup
        .Delete
    End With
                
End Sub
Sub Copy_Controls(To_Bar As CommandBar, From_Bar As String, Optional BlankLine As Boolean = False)
Dim CBar    As CommandBarControl
On Error Resume Next
    With To_Bar
        ' Ligne de séparation
        If BlankLine Then .Controls.Add(msoControlButton, , , .Controls.Count + 1, True).Caption = ""
        ' Controls habituels du click droit
        With .Controls.Add(msoControlPopup, , , .Controls.Count + 1, True)
            ' .BeginGroup = True
             .Caption = "Autres Choix"
            For Each CBar In CommandBars(From_Bar).Controls
                .Controls.Add CBar.Type, CBar.ID, , , True
            Next
         End With
    End With

End Sub
Sub Show_Tab()
Dim Target As String
    With CommandBars.ActionControl
        Select Case .Type
        Case msoControlButton: Target = .Caption
        Case msoControlDropdown: Target = .Text
        Case Else: Exit Sub
        End Select
        With Worksheets(Target)
            .Visible = True
            .Activate
        End With
    End With
End Sub

bobinut60 · 31 Décembre 2021

Bonjour Job75 Merci beaucoup cela fonctionne a merveille.
est ce qu'il est possible que cela soit accessible depuis le menu contextuel clic droit d'excel (un sous menu par ex?)
et que lorsque que je choisi un onglet on active la feuille sélectionnée..
merci

Bernard_XLD · 31 Décembre 2021

Bonjour bobinut60, job75, fanch55, le forum

Une proposition de modification du menu contextuel pour la souris bouton droit, code à placer entièrement dans Thisworkbook, actif uniquement sur le classeur contenant le code.
voir fichier exemple.

Bien cordialement, @+

VB:

Private Sub Workbook_Activate()
Application.CommandBars("Cell").Reset
Dim Compteur%, Compteur2%
For Compteur = ThisWorkbook.Sheets.Count To 1 Step -1
    If ThisWorkbook.Sheets(Compteur).Visible = True Then
        Compteur2 = Compteur2 + 1
        With Application.CommandBars("Cell")
            With .Controls.Add(Type:=msoControlButton, Before:=1)
                .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Dest " & Chr(34) & ThisWorkbook.Sheets(Compteur).Name & Chr(34) & "'"
                .FaceId = 350
                .Caption = ThisWorkbook.Sheets(Compteur).Name
            End With
        End With
    End If
Next Compteur
Application.CommandBars("Cell").Controls(Compteur2 + 1).BeginGroup = True
End Sub
Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").Reset
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Cell").Reset
End Sub
Private Sub Select_Dest(Nom_Feuille$)
    Application.Goto Reference:=ThisWorkbook.Sheets(Nom_Feuille).Range(ActiveCell.Address)
    ActiveCell.Select
End Sub

bobinut60 · 31 Décembre 2021

Bonjour Fanch55
si on pouvait garder le menu classique excel et ajouter le menu "activer feuille" ce serait top

merci vous etes trop fort

Bernard_XLD · 31 Décembre 2021

Re,

j'avais compris que vous désiriez sélectionner la même cellule que dans la feuille appelante, si ce n'est pas le cas, enlevez la ligne
Activecell.Select
dans la macro Select_Dest ou remplacez la par cette macro plus simple

VB:

Private Sub Select_Dest(Nom_Feuille$)
    ThisWorkbook.Sheets(Nom_Feuille).Select
End Sub

fanch55 · 31 Décembre 2021

Le menu Classique est accessible dans "Autres choix".

Mais si vous le préférez ainsi :

VB:

Sub W_Brc(ByVal Target As Range, Cancel As Boolean) ' Worksheet_BeforeRightClick
Dim Sh      As Worksheet
Dim Control As Object
Dim Rbar    As CommandBar
Const Cb = "RightClick"
    Cancel = True
    On Error Resume Next: CommandBars(Cb).Delete: On Error GoTo 0
    Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
    With Rbar
        With .Controls.Add(msoControlPopup, , , .Controls.Count + 1, True)
            .Caption = "Activer feuille"
            For Each Sh In ThisWorkbook.Worksheets
                Select Case True
                Case Sh.Name = ActiveSheet.Name
                Case Sh.Type <> xlWorksheet
                Case Else
                    With .Controls.Add(msoControlButton, , , , True)
                        .Caption = Sh.Name
                        .FaceId = 1154
                        .OnAction = "Show_Tab"
                    End With
                End Select
            Next
        End With
        Copy_Controls Rbar, IIf(ActiveCell.ListObject Is Nothing, "Cell", "List Range Popup"), True
        .ShowPopup
        .Delete
    End With
                
End Sub
Sub Copy_Controls(To_Bar As CommandBar, From_Bar As String, Optional BlankLine As Boolean = False)
Dim CBar    As CommandBarControl
On Error Resume Next
    With To_Bar
        ' Ligne de séparation
        If BlankLine Then .Controls.Add(msoControlButton, , , .Controls.Count + 1, True).Caption = ""
        ' Controls habituels du click droit
'        With .Controls.Add(msoControlPopup, , , .Controls.Count + 1, True)
'            ' .BeginGroup = True
'             .Caption = "Autres Choix"
            For Each CBar In CommandBars(From_Bar).Controls
                .Controls.Add CBar.Type, CBar.ID, , , True
            Next
'         End With
    End With

End Sub
Sub Show_Tab()
Dim Target As String
    With CommandBars.ActionControl
        Select Case .Type
        Case msoControlButton: Target = .Caption
        Case msoControlDropdown: Target = .Text
        Case Else: Exit Sub
        End Select
        With Worksheets(Target)
            .Visible = True
            .Activate
        End With
    End With
End Sub

Bernard_XLD · 31 Décembre 2021

Re,

le même avec un sous menu

Bien cordialement, @+

[nouvelle version]

Eric C · 31 Décembre 2021

Bonjour le forum
Bonjour à tous

Je sais que notre ami a demandé un code Vba afin de parvenir à ses fins il ne sait peut être pas qu'un click droit sur les flèches de sélection en bas à gauche des onglets, fait apparaitre un popup. Celui-ci récapitule les onglets présents dans le classeur et le déplacement est tout aussi aisé. Bon, maintenant, il en a peut être besoin de ce code Vba.

Bon réveillon à toutes & à tous.

Bernard_XLD · 31 Décembre 2021

Re,

Eric C à dit:
Bonjour le forum
Bonjour à tous

Je sais que notre ami a demandé un code Vba afin de parvenir à ses fins il ne sait peut être pas qu'un click droit sur les flèches de sélection en bas à gauche des onglets, fait apparaitre un popup. Celui-ci récapitule les onglets présents dans le classeur et le déplacement est tout aussi aisé. Bon, maintenant, il en a peut être besoin de ce code Vba.

Bon réveillon à toutes & à tous.

Bonjour Eric C, excellente réflexion !
j'étais de toute façon transparent !

Bonne soirée et bon réveillon

job75 · 31 Décembre 2021

Bonsoir fanch55, Yeahou, Eric C,

Pas du tout transparent Yeahou

Ton code est simple mais il y a un problème si l'on modifie le nom d'une feuille.

Pour y remédier il faudra protéger le classeur.

A+

bobinut60 · 31 Décembre 2021

WOUAOUHHH
quelle réactivité

et cela correspond tout a fait a ce que je cherchais. je connaissais la manip pour le popup mais j'avais besoin de votre code pour comprendre la méthode utilisée.
Un grand merci a vous tous et je vous souhaite d'excellentes fêtes de fin d'année.

Bernard_XLD · 31 Décembre 2021

Re,

job75 à dit:
Bonsoir fanch55, Yeahou, Eric C,

Pas du tout transparent Yeahou

Ton code est simple mais il y a un problème si l'on modifie le nom d'une feuille.

Pour y remédier il faudra protéger le classeur.

Judicieuse remarque, on peut aussi, sans protéger la structure, gérer les cas de renommage, ajout, supression de feuille tout en restant uniquement dans ThisWorkbook.

Bien cordialement, @+

VB:

Private Sub Workbook_Activate()
DoEvents
Application.CommandBars("Cell").Reset
Dim Compteur%
With Application.CommandBars("Cell")
    With .Controls.Add(msoControlPopup, , , 1, True)
        .Caption = "Aller à l'onglet ..."
        For Compteur = ThisWorkbook.Sheets.Count To 1 Step -1
            If ThisWorkbook.Sheets(Compteur).Visible = True Then
                With .Controls.Add(Type:=msoControlButton, Before:=1)
                    .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Feuille " & Chr(34) & ThisWorkbook.Sheets(Compteur).Name & Chr(34) & "'"
                    .FaceId = 350
                    .Caption = ThisWorkbook.Sheets(Compteur).Name
                End With
            End If
        Next Compteur
    End With
    .Controls(2).BeginGroup = True
End With
End Sub
Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").Reset
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Cell").Reset
End Sub
Private Sub Select_Feuille(Nom_Feuille$)
    If Feuille_Existe(Nom_Feuille) Then
        Sheets(Nom_Feuille).Select
    Else
        MsgBox "La feuille " & Nom_Feuille & " n'existe plus, menu contextuel réinitialisé.", vbOKOnly + vbInformation
        Workbook_Activate
    End If
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Workbook_Activate
End Sub
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
    Application.OnTime Now() + TimeValue("00:00:01"), "'" & ThisWorkbook.Name & "'!Thisworkbook.Workbook_Activate"
End Sub
Function Feuille_Existe(NomFeuille$) As Boolean
    On Error Resume Next
    Set Test_objet = ActiveWorkbook.Sheets(NomFeuille)
    Feuille_Existe = Not Test_objet Is Nothing
End Function

patricktoulon · 31 Décembre 2021

Bonsoir
dans le module thisworkbook

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
CommandBars("Cell").Reset
End Sub
Private Sub Workbook_Open()
UPDATE_BAR
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
UPDATE_BAR
End Sub

dans un module standard

VB:

Sub UPDATE_BAR()
    Dim bar, sh As Worksheet, pop
    Set bar = CommandBars("Cell"): bar.Reset
    Set pop = bar.Controls.Add(msoControlPopup, Before:=1)    'sub menu global
    pop.Caption = "mes feuilles"    'a adapter
    For Each sh In Worksheets
        With pop.Controls.Add(msoControlButton):
            .Caption = sh.Name: .OnAction = "sheetsshow"
        End With
    Next
End Sub

Sub sheetsshow()
Sheets(Application.CommandBars.ActionControl.Caption).Activate
End Sub

ton menu est constamment à jour il est mis ajour lors du click droit n'importe ou dans une des feuilles

Effectuez une recherche sur Excel Downloads...

XL 2013 afficher les onglets du classeur dans menu clic droit

bobinut60

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

bobinut60

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

bobinut60

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

Eric C

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

bobinut60

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums