Adaption code VBA - Menu à sélection multiple

Messages postés
73
Date d'inscription
lundi 15 juin 2015
Statut
Membre
Dernière intervention
14 novembre 2019
-
Bonjour à toi,

Il y a un peu plus de 2 ans, j'ai fais appel au forum pour mettre en place un menu déroulant à sélection multiple : https://www.commentcamarche.net/forum/affich-34721361-menu-deroulant-a-selection-multiple#p34746067

Aujourd'hui, j'en ai à nouveau besoin, mais je peine à adapter le code qu'on m'avait donné...
A l'origine, le codage était adapté pour plusieurs colonne et aujourd'hui il faudrait que ça s'applique sur une seule colonne. Malgré que je change la plage sélectionnée, les colonnes de fournitures etc... Rien ne fonctionne. J'en appelle à vous !

A savoir, j'aimerai que le menu à sélection multiple s'applique de C7:C100

Le code appliqué sur la feuille où le menu est :
Option Explicit

' constantes décrvant la configuration - à adapter

Const plageLB As String = "C7:C100" ' plage à traiter
Const lideb As Byte = 6 ' ligne des fournitures
Const codeb As Byte = 3 ' premiere colonne fournitures
Const sep As String = " + " ' séparateur - si tu preferes une foruniture par ligne
' tu mets vblf (pour line feed)

Dim interne As Boolean

Private Sub LbLIste_Change()
Dim ch As String, i As Long
If Not interne Then
ch = ""
For i = 0 To LbListe.ListCount - 1
If LbListe.Selected(i) = True Then ch = ch & sep & LbListe.List(i)
Next i
ch = Mid(ch, Len(sep) + 1)
ActiveCell = ch
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ch As String, ch2 As String, i As Long
Dim plage, topIndex As Boolean
Dim four As String, co As Long
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range(plageLB)) Is Nothing Then LbListe.Visible = False: Exit Sub
co = Target.Column
four = Cells(lideb, co).Value
plage = PlageListe(four)
If plage = False Then
MsgBox "erreur : " & four & " n'est pas dans la feuille " & FL
Exit Sub
End If
' initialiser listbox
LbListe.ListFillRange = FL & "!" & plage
LbListe.Top = Target.Top
LbListe.Left = Target.Offset(0, 1).Left
LbListe.Width = 100
LbListe.Height = LbListe.ListCount * (ActiveCell.Font.Size + 2) + 10
LbListe.MultiSelect = fmMultiSelectMulti
topIndex = False
' maj selection dans lbListe
interne = True ' palliatif, EnableEvents ne marche pas
ch = ActiveCell
ch2 = sep & ch & sep
topIndex = False
For i = 0 To LbListe.ListCount - 1
If InStr(ch2, LbListe.List(i)) > 0 Then
' l'item a été trouvé dans la cellule
LbListe.Selected(i) = True
If Not topIndex Then
LbListe.topIndex = i ' le 1er sélectionné doit être visible dans la textbox
topIndex = True
End If
End If
Next i
interne = False
LbListe.Visible = True
End Sub


Code mis dans un module :
Option Explicit

' constantes décrvant la configuration

' Feuille Liste
Public Const FL As String = "Listes" ' nom de la feuille
Public Const liFL As Byte = 1 ' ligne des fournitures

Public Function PlageListe(F As String)
Dim n As Byte, lifin As Byte, co As Byte, obj As Object
With Sheets(FL)
Set obj = .Rows(liFL).Find(F, , , xlWhole)
If obj Is Nothing Then PlageListe = False: Exit Function
co = obj.Column
lifin = .Cells(Rows.Count, co).End(xlUp).Row
PlageListe = .Range(.Cells(liFL + 1, co), .Cells(lifin, co)).Address
End With
End Function

Sub reinit()
Application.EnableEvents = True
End Sub



Merci d'avance de prendre du temps pour solutionner mon problème !
Belle journée.


Bye bye
« Avant de rêver, il faut savoir. »
Afficher la suite 

2 réponses

Meilleure réponse
Messages postés
632
Date d'inscription
dimanche 15 novembre 2015
Statut
Membre
Dernière intervention
14 novembre 2019
66
1
Merci
Bonjour

Un essai pour le fonctionnement d'un menu à sélection multiple sur plusieurs feuilles

https://mon-partage.fr/f/Zo61T4PA/

Slts

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 70935 internautes nous ont dit merci ce mois-ci

Liitch
Messages postés
73
Date d'inscription
lundi 15 juin 2015
Statut
Membre
Dernière intervention
14 novembre 2019
-
Bonjour,

Je te remercie beaucoup, c'est exactement ce que je souhaitais !

Par contre, je dois systématiquement cliquer sur le bouton reset pour chaque nouvelle ligne. Afin que la macro fonctionne. Est-ce qu'il y a un moyen de l'éviter ?

Merci encore.
Bien cordialement.
Commenter la réponse de The_boss_68
Messages postés
632
Date d'inscription
dimanche 15 novembre 2015
Statut
Membre
Dernière intervention
14 novembre 2019
66
0
Merci
Bonsoir,

Merci de mettre à la dispo un fichier anonymiser

Slts
Liitch
Messages postés
73
Date d'inscription
lundi 15 juin 2015
Statut
Membre
Dernière intervention
14 novembre 2019
-
Bonjour,

Excusez moi pour ma réponse très tardive. J'ai eu du mal à prendre le temps d'anonymiser mon fichier !
Le voici : https://www.cjoint.com/c/IKmoH4OQShR

Information supplémentaire que je n'avais pas dit, il faudrait que ce menu déroulant à sélection multiple soit répété sur 12 feuilles (qui correspond aux 12 mois de l'année).

Dans mon fichier joint, ce serait sur la colonne "Projet" de chaque tableau qui se trouve sur les feuilles. Cette colonne correspondra toujours à la colonne C et débutera toujours à la ligne 7. Par contre le tableau mensuel est rempli au fur et à mesure. Il faut donc prendre en compte le fait qu'il puisse s'agrandir.
Les éléments de ma liste sont notés sur la feuille nommée "Listes"

Merci beaucoup pour le temps consacré !
Belle journée.
Commenter la réponse de The_boss_68