Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 afficher les onglets du classeur dans menu clic droit

bobinut60

XLDnaute Nouveau
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

XLDnaute Barbatruc
re
si j'avais utilisé une barre perso c'est pareil je delete après le showpopup
VB:
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

XLDnaute Barbatruc
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
 

patricktoulon

XLDnaute Barbatruc
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)
VB:
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

XLDnaute Barbatruc
re
et finalement on peut se simplifier les choses en choisissant quelle barre a modifier avant
VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…