Adaption code VBA - Menu à sélection multiple

A voir également:Adaption code vba - menu à sélection multipleFormule vba pour une selection multiple avec souris ✓ - Forum - Excel Menu déroulant à sélection multiple ✓ - Forum - Excel Code VBA pour listes déroulantes non adapté ✓ - Forum - VB / VBA Code VBA n'appartient pas à la sélection ✓ - Forum - Excel Microsoft teredo tunneling adapter code 10 ✓ - Forum - Réseau

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. »

Forum

A voir également:Adaption code vba - menu à sélection multipleFormule vba pour une selection multiple avec souris ✓ - Forum - Excel Menu déroulant à sélection multiple ✓ - Forum - Excel Code VBA pour listes déroulantes non adapté ✓ - Forum - VB / VBA Code VBA n'appartient pas à la sélection ✓ - Forum - Excel Microsoft teredo tunneling adapter code 10 ✓ - Forum - Réseau

Web: www.shapebootstrap.net

5 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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 69408 internautes nous ont dit merci ce mois-ci

Reply
réponses:
  • auteur

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonsoir,

Merci de mettre à la dispo un fichier anonymiser

Slts

Reply
réponses:
  • auteur

  • auteur

  • auteur

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

En fait je l'avais déjà inclut dans le fichier du post3 mais malheureusement ça ne fonctionne pas. Alors comme je te l'ai dit avec une macro dans chaque feuille ça devrait fonctionner, alors si cela te tente..... à moins qu'un contributeur aurait une solution

Application.EnableEvents = True


Slts

Reply
réponses:
  • auteur

  • auteur

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonsoir f894009

Voir la macro dans ThisWorkbook du fichier post #3

En fait dans la plage C7:C9 il y a une liste déroulante à choix multiples, le problème récurant actuel est...... lorsque l'on rajoute une ligne sous C9 la liste déroulante à choix multiples ne fonctionne plus, il faut appuyer sur reset pour qu'elle re-fonctionne alors le demandeur Liitch avait suggérer d'inclure
Application.EnableEvents = True dans la macro pour éviter d'appuyer chaque fois sur reset pour que la liste déroulante à choix multiples re-fonctionne de nouveau, je lui ai dis que Application.EnableEvents = True était déjà inclu dans la macro et qu’apparemment cela ne Reset pas automatiquement

Pour info f894009 s'il tu aurais une solution ce serait le top

Slts

Reply
réponses:
  • auteur

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour f894009,

Merci pour moi et Liitch , effectivement après différent essais.... ta macro, fonctionne sans aucune erreur

Merci

Slts

Reply
réponses:
  • auteur

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed