XL 2013 afficher les onglets du classeur dans menu clic droit

[bobinut60]

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

 

[patricktoulon]

re
@Yeahou
non elle n'est pas par défaut mais effectivement sur certaines config le trait est invisible, je l'ai remarqué

 

[fanch55]

Bar "Cells"	Bar "List Range Popup"

 

[Bernard_XLD]

non elle n'est pas par défaut mais effectivement sur certaines config le trait est invisible, je l'ai remarqué

Je n'ai jamais rencontré le cas mais je te crois sur parole

 

[job75]

c'est cosmétique, cela met une séparation visuelle entre le menu ajouté et le menu standard.

Sur Excel 2019 avec ou sans .Controls(2).BeginGroup = True il n'y a aucune séparation.

 

[patricktoulon]

re
si j'avais utilisé une barre perso c'est pareil je delete après le showpopup

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i%, barre As CommandBar, pop As CommandBarControl,cmb as commandbar
    Set barre = Application.CommandBars.Add("menuperso", msoBarPopup, False, True)
    Set pop = barre.Controls.Add(msoControlPopup, 1, , , True): pop.Caption = "Aller à l'onglet ..."
    For i = 1 To ThisWorkbook.Sheets.Count
        If ThisWorkbook.Sheets(i).Visible And Not ThisWorkbook.Sheets(i).Name = Sh.Name Then
            With pop.Controls.Add(Type:=msoControlButton)
                .Caption = ThisWorkbook.Sheets(i).Name
                .FaceId = 350
                .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Feuille " & Chr(34) & .Caption & Chr(34) & "'"
            End With
        End If
    Next i
    barre.ShowPopup
    barre.Delete
    Cancel = True
texte = "la barre ""menuperso"" n'existe pas "
For Each cmb In Application.CommandBars
If cmb.Name = "menuperso" Then texte = "la barre existe toujours "
Next
MsgBox texte
End Sub

Private Sub Select_Feuille(Nom_Feuille$)
    Sheets(Nom_Feuille).Select
End Sub

 

[patricktoulon]

Sur Excel 2019 avec ou sans .Controls(2).BeginGroup = True il n'y a aucune séparation.

c'est bien ce que je disais

 

[Bernard_XLD]

Sur Excel 2019 avec ou sans .Controls(2).BeginGroup = True il n'y a aucune séparation.

Re,
encore une différence de version, sur 365, elle est bien là si l'instruction est présente

 

[patricktoulon]

re
@Yeahou office 365 ok mais excel quelle version ?

 

[Bernard_XLD]

@Yeahou office 365 ok mais excel quelle version ?

 

[patricktoulon]

re
@Yeahou non pas l'environnement mais l'index de version

Sub test()
MsgBox Application.Version
End Sub

edit:
donc tu est en excel 2016 sur ta capture

 

[fanch55]

Excel 2019 64bits :
La ligne est bien présente :

 

[patricktoulon]

re
oui je pense que c'est plutôt config que version ou association des deux
c'est tellement obscure avec les dernières version d'excel qu'il est difficile de déterminer le soucis
je l'avais remarqué sur excel 2016 64 bits d'origine sur mon portable quand j'ai rétrogradé en 32 bits certains aspects cosmétique sont revenus
après c'est pas bien grave

 

[job75]

Excel 2019 64bits :
La ligne est bien présente :

Ah oui ma vue baisse, chez moi aussi sur Excel 2019 64 bits la séparation est bien présente.

 

[patricktoulon]

re
vous l'avez dans les deux menus toujours avec la méthode ShowPopup
il faut juste déterminer quelle barre a afficher (Cell ou List Range Popup)

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i%, Bar1 As CommandBar, Bar2 As CommandBar, barX As CommandBar

    Set Bar1 = Application.CommandBars("Cell")
    Set Bar2 = Application.CommandBars("List Range Popup")

    With Bar1
        .Reset
        With .Controls.Add(msoControlPopup, , , 1, True)
            .Caption = "Aller à l'onglet ..."
            For i = 1 To ThisWorkbook.Sheets.Count
                If ThisWorkbook.Sheets(i).Visible And Not ThisWorkbook.Sheets(i).Name = Sh.Name Then
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = ThisWorkbook.Sheets(i).Name
                        .FaceId = 350
                        .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Feuille " & Chr(34) & .Caption & Chr(34) & "'"
                    End With
                End If
            Next i
        End With
        .Controls(2).BeginGroup = True
    End With

    With Bar2
        .Reset
        With .Controls.Add(msoControlPopup, , , 1, True)
            .Caption = "Aller à l'onglet ..."
            For i = 1 To ThisWorkbook.Sheets.Count
                If ThisWorkbook.Sheets(i).Visible And Not ThisWorkbook.Sheets(i).Name = Sh.Name Then
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = ThisWorkbook.Sheets(i).Name
                        .FaceId = 350
                        .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Feuille " & Chr(34) & .Caption & Chr(34) & "'"
                    End With
                End If
            Next i
        End With
        .Controls(2).BeginGroup = True
    End With

    Set barX = Bar1
    For Each lsto In Sh.ListObjects
        'on choisi quelle barre  à afficher en testant le intesect sur les listbobject et la cellule active
        If Not Intersect(lsto.DataBodyRange, ActiveCell) Is Nothing Then Set barX = Bar2
    Next
    barX.ShowPopup
    MsgBox "c'est le menu " & barX.Name & " qui a été lancé"
    Bar1.Reset
    Bar2.Reset
    Cancel = True
Set barX = Nothing
End Sub
Private Sub Select_Feuille(Nom_Feuille$)
    Sheets(Nom_Feuille).Select
End Sub

 

[patricktoulon]

re
et finalement on peut se simplifier les choses en choisissant quelle barre a modifier avant

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i%, barX As CommandBar, lsto As ListObject
    Set barX = Application.CommandBars("Cell")
    For Each lsto In Sh.ListObjects
        'on choisi quelle barre  à afficher en testant le intesect sur les listbobject et la cellule active
        If Not Intersect(lsto.DataBodyRange, ActiveCell) Is Nothing Then Set barX = Application.CommandBars("List Range Popup")
    Next
    With barX
        .Reset
        With .Controls.Add(msoControlPopup, , , 1, True)
            .Caption = "Aller à l'onglet ..."
            For i = 1 To ThisWorkbook.Sheets.Count
                If ThisWorkbook.Sheets(i).Visible And Not ThisWorkbook.Sheets(i).Name = Sh.Name Then
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = ThisWorkbook.Sheets(i).Name
                        .FaceId = 350
                        .OnAction = ThisWorkbook.Name & "!'Thisworkbook.Select_Feuille " & Chr(34) & .Caption & Chr(34) & "'"
                    End With
                End If
            Next i
        End With
        .Controls(2).BeginGroup = True
    End With

    barX.ShowPopup
    MsgBox "c'est le menu " & barX.Name & " qui a été lancé"
    barX.Reset
    Cancel = True
    Set barX = Nothing
End Sub
Private Sub Select_Feuille(Nom_Feuille$)
    Sheets(Nom_Feuille).Select
End Sub