XL 2021 Atteindre l'onglet du Client au clic sur son nom dans ma ListBox

[Usine à gaz]

Bonjour à toutes et à tous

Je voudrais faire un codage que je ne sais (évidemment lol) pas faire.
C'est plus pour le fun !

Le contexte
Chaque fin de mois, je facture mes Clients
- Quand je valide dans onglet "Facture" une facturation, la facture est enregistrée dans un nouvel onglet au nom du Client concerné.

Je peux avoir ainsi jusqu'a une cinquantaine d'onglets (1 par Client),
Pour "atteindre l'onglet d'un Client, il "me faut me promener" dans les onglets pour le trouver.

Evidemment, il a la possibilité de faire un clic droit, en bas à gauche des onglets pour afficher la liste des Clients et atteindre l'onglet au clic sur le nom.

Pour le fun, j'aimerais pouvoir atteindre l'onglet du Client au clic sur son nom dans ma ListBox.

Pensez-vous que ce soit possible ?

En cas, je joins un petit fichier test et je continuerai à chercher ce soir.

Merci à toutes et à tous

 

[scraper]

Bonjour
Une adaptation sur un code trouvé en ligne

Private Sub ListBox1_Click()
Dim strng As String
Dim lCol As Long, lRow As Long

With Me.ListBox1 '<--| refer to your listbox: change "ListBox1" with your actual listbox name
For lRow = 0 To .ListCount - 1 '<--| loop through listbox rows
If .Selected(lRow) Then '<--| if current row selected
For lCol = 0 To .ColumnCount - 1 '<--| loop through listbox columns
strng = strng & .List(lRow, lCol) & " | " '<--| build your output string
Next lCol
ThisWorkbook.Worksheets(Split(strng, " | ")(2)).Select
'MsgBox "you selected" & vbCrLf & Left(strng, (Len(strng) - 1)) '<--| show output string (after removing its last character ("|"))
Exit For '<-_| exit loop
End If
Next lRow
End With

End Sub

 

[TooFatBoy]

Bonjour,

Une proposition :

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Sheets(ListBox1.List(ListBox1.Index, 2)).Activate
End Sub

---

il a la possibilité de faire un clic droit

Qui ça "il" ??? Ton client ?

 

[sylvanu]

Bonjour Lionel,
Pourquoi une ListBox, à part pour le fun ?
Je pense qu'il serait plus intéressant de construire une liste de RdV en première feuille qui se réactualise quand on la sélectionne , avec :

Sub Worksheet_Activate()
    On Error Resume Next
    [ListeRDV].ListObject.DataBodyRange.Delete
    On Error GoTo Fin
    Application.EnableEvents = False
    L = 1
    For Each F In Worksheets
        If F.Name <> "Nbr RdV" And F.Name <> "Facture" Then ' Exclusions de feuilles
            With Sheets(F.Name)
                [ListeRDV].Item(L, 1) = .[V9] & " " & .[X9]     ' Client
                [ListeRDV].Item(L, 2) = Format(.[X8], "dd/mm/yyyy") ' Etat arrêté au :
                [ListeRDV].Item(L, 3) = .[B17]                  ' Total RdV + bonus
                [ListeRDV].Item(L, 4) = .[F17]                  ' Total RdV consom.
                [ListeRDV].Item(L, 5) = .[N17]                  ' Nv Pack
                [ListeRDV].Item(L, 6) = F.Name                  ' Feuille
                L = L + 1
            End With
        End If
    Next F
Fin:
Application.EnableEvents = True
End Sub

puis en cliquant sur un nom d'accéder à la feuille avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo FinF
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B2:G1000]) Is Nothing Then
        If Target = "" Then Exit Sub
        NomFeuille = Cells(Target.Row, "G")
        Sheets(NomFeuille).Activate
    End If
FinF:
End Sub

Une maquette en PJ.

 

[Dudu2]

Bonjour,
J'ai un code là-dessus. A récupérer et intégrer éventuellement.
Escape pour sortir du UserForm / ComboBox sans choix.

 

[Usine à gaz]

Bonjour,

Une proposition :

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Sheets(ListBox1.List(ListBox1.Index, 2)).Activate
End Sub

---

Qui ça "il" ??? Ton client ?

Bonjour Lionel,
Pourquoi une ListBox, à part pour le fun ?
Je pense qu'il serait plus intéressant de construire une liste de RdV en première feuille qui se réactualise quand on la sélectionne , avec :

Sub Worksheet_Activate()
    On Error Resume Next
    [ListeRDV].ListObject.DataBodyRange.Delete
    On Error GoTo Fin
    Application.EnableEvents = False
    L = 1
    For Each F In Worksheets
        If F.Name <> "Nbr RdV" And F.Name <> "Facture" Then ' Exclusions de feuilles
            With Sheets(F.Name)
                [ListeRDV].Item(L, 1) = .[V9] & " " & .[X9]     ' Client
                [ListeRDV].Item(L, 2) = Format(.[X8], "dd/mm/yyyy") ' Etat arrêté au :
                [ListeRDV].Item(L, 3) = .[B17]                  ' Total RdV + bonus
                [ListeRDV].Item(L, 4) = .[F17]                  ' Total RdV consom.
                [ListeRDV].Item(L, 5) = .[N17]                  ' Nv Pack
                [ListeRDV].Item(L, 6) = F.Name                  ' Feuille
                L = L + 1
            End With
        End If
    Next F
Fin:
Application.EnableEvents = True
End Sub

puis en cliquant sur un nom d'accéder à la feuille avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo FinF
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B2:G1000]) Is Nothing Then
        If Target = "" Then Exit Sub
        NomFeuille = Cells(Target.Row, "G")
        Sheets(NomFeuille).Activate
    End If
FinF:
End Sub

Une maquette en PJ.

Bjour à toi
Merci pour l'idée, les codes et fichier.
Je regarde tout ça ce soir

 

[Usine à gaz]

Bonjour,
J'ai un code là-dessus. A récupérer et intégrer éventuellement.
Escape pour sortir du UserForm / ComboBox sans choix.

Bjour à toi
Merci pour l'idée, les codes et fichier.
Je regarde tout ça ce soir

 

[Usine à gaz]

Bonjour
Une adaptation sur un code trouvé en ligne

Private Sub ListBox1_Click()
Dim strng As String
Dim lCol As Long, lRow As Long

With Me.ListBox1 '<--| refer to your listbox: change "ListBox1" with your actual listbox name
For lRow = 0 To .ListCount - 1 '<--| loop through listbox rows
If .Selected(lRow) Then '<--| if current row selected
For lCol = 0 To .ColumnCount - 1 '<--| loop through listbox columns
strng = strng & .List(lRow, lCol) & " | " '<--| build your output string
Next lCol
ThisWorkbook.Worksheets(Split(strng, " | ")(2)).Select
'MsgBox "you selected" & vbCrLf & Left(strng, (Len(strng) - 1)) '<--| show output string (after removing its last character ("|"))
Exit For '<-_| exit loop
End If
Next lRow
End With

End Sub

Bjour à toi
Je regarde tout ça ce soir

 

[Usine à gaz]

Bonjour,

Une proposition :

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Sheets(ListBox1.List(ListBox1.Index, 2)).Activate
End Sub

---

Qui ça "il" ??? Ton client ?

Re-Bjr et merci.
Code très court : je n'ai pas résisté lol.
C'est nickel...
Le double clic me fatigue... Y'a pas possible en simple clic ?
(lol, je sais ce que tu vas dire toi)

 

[TooFatBoy]

Code très court : je n'ai pas résisté lol.

Le double clic me fatigue... Y'a pas possible en simple clic ?
(lol, je sais ce que tu vas dire toi)

Je ne sais pas si c'est ce à quoi tu t'attendais, mais je dirais : perso je préfère le double-clic, mais si tu préfères le simple-clic c'est vous qui voyez...

Si tu enlèves "Dbl" dans le nom de la macro, ça devrait le faire.

 

[job75]

Bonjour Lionel, le fil,

Comme l'a dit sylvanu la ListBox me paraît totalement inutile.

Mettre en Z9 (cellule jaune) une liste de validation pour choisir le client.

Un double-clic dans cette cellule permet d'atteindre la feuille du client :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [Z9]) Is Nothing Then Exit Sub
Cancel = True
On Error Resume Next
Sheets(Target(1).Value).Activate
End Sub

A+

 

[TooFatBoy]

Un double-clic dans cette cellule

Rappel :

Le double clic me fatigue...

 

[job75]

Alors le clic droit :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(ActiveCell, [Z9]) Is Nothing Then Exit Sub
Cancel = True
On Error Resume Next
Sheets(ActiveCell.Value).Activate
End Sub

 

[Dudu2]

Bonsoir,
En y repensant, le problème d'un choix sur la page initiale (Facture) c'est ergonomiquement jouable si toutes ou presque toutes les feuilles sont présentes dans la liste en bas de page. Car pour revenir sur la page initiale c'est simple, elle est toujours visible dans cette liste. D'ailleurs est-ce bien utile d'avoir ce mécanisme si toutes les feuilles sont visibles ?

Mais avec 60 feuilles clients ce ne sera plus le cas et pour revenir, il va falloir en faire des clics sur ce bouton

Alors j'ai intégré le code du Post #5 (simplifié) qui est ici invocable simplement avec la touche F1 sur n'importe quelle feuille pour permettre d'aller sur n'importe quelle autre feuille, y compris la feuille Facture.
La liste des feuilles est dynamiquement construite évitant d'avoir à la gérer manuellement.
Le UserForm contenant la ComboBox est vbModeless pour plus de souplesse.
Edit: Et le code est pour le moins minimaliste.

 

[laurent950]

Bonsoir @Usine à gaz

La feuille "Nbr RdV" ne sert plus a rien dans le fichier ?

A Placer dans la Feuille Facture
Alors si Le double clic te fatigue... Y'a une possibilité en simple clic c'est fait.

Function RemplirListeBox() As Boolean
    Dim Cptws As Sheets
    Dim ws As Worksheet
    Dim cpt As Integer
    Dim listBox As MSForms.listBox
    Dim Titre As Variant
    Dim i As Byte
  
    ' Connaitres le nombre de feuilles
        Set Cptws = ThisWorkbook.Parent.Worksheets
  
    ' Assurez-vous que le nom de votre ListBox est correctement référencé ici (ListBox1 par défaut)
        Set listBox = Me.ListBox1
  
        ' Si le Nombres de Feuilles et supérieur ou inférieur au nombres de lignes de la ListBox
        ' Recréer la ListBox
            For Each ws In Cptws
                If ws.Name Like "Client *" Then
                    cpt = cpt + 1
                End If
            Next ws
            If listBox.ListCount - 1 <> cpt Then

        ' Effacer les éléments actuels de la ListBox
            listBox.Clear
      
        ' Spécifiez les en-têtes de colonnes
            Titre = Array("N°", "Clients", "Prénoms", "Nb RdV")
          
          
        ' Spécifiez les largeurs de colonnes (0 pt;30 pt;120 pt;80 pt;40 pt)
                listBox.ColumnWidths = "80 pt;120 pt;80 pt;40 pt"
                listBox.ColumnCount = 4 ' Nombre de colonnes
          
        ' Ajoutez les en-têtes de colonne à la ListBox
        ' Enregistrez les données du tableau dans la ligne des en-têtes
        ' Créer la Premiére ligne / Colonne 1
            listBox.AddItem Titre(i)
            For i = 1 To UBound(Titre)
                listBox.List(listBox.ListCount - 1, i) = Titre(i) ' la Premiére ligne / Colonne 1/2/3
            Next i
      
        On Error Resume Next
        ' Boucler à travers toutes les feuilles du classeur
                For Each ws In ThisWorkbook.Worksheets
                   If ws.Name Like "Client " & "*" Then
                    listBox.AddItem Split(ws.Name, " ")(1)
                    listBox.List(listBox.ListCount - 1, 1) = ws.Name
                    listBox.List(listBox.ListCount - 1, 2) = Split(ws.Range("x9").Value, " ")(2)
                    listBox.List(listBox.ListCount - 1, 3) = Split(Split(ws.Range("R19").Value, ">")(1), " ")(2)
                  End If
                Next ws
        On Error GoTo 0
              
        ' Le test est Vrai
            RemplirListeBox = True
    End If
End Function

Private Sub ListBox1_Click()
    Dim ws As Worksheet
    Dim listBox As MSForms.listBox
    Dim selectedClient As String
    Dim SelctFlag As Boolean
  
    Set listBox = Me.ListBox1
  
    ' Récupérer le nom du client sélectionné dans la ListBox
        selectedClient = listBox.List(ListBox1.ListIndex, 1)
  
    ' Test de vérification Nombres de feuilles excel = Nombres de lignes Listbox
        SelctFlag = RemplirListeBox
  
    ' Si les test est vrai le nombres de lignes de la listeBox ne correspond pas au nombres de feuilles
    ' Recommencer l'opération ' Mise a jour de la ListBox
        If SelctFlag = True Then
            MsgBox "La Mise a jour de la ListBox à était faite....." & vbCrLf & "Veuillez recommencer une nouvelle selection !"
            Exit Sub
        End If
        ' Le nom de l'onglet qui correspond au client sélectionné
            Set ws = ThisWorkbook.Worksheets(selectedClient)
        ' Activer l'onglet si le nom correspond
            ws.Activate
End Sub