XL 2010 Question sur les Useform avec liste en cascade

Yannic

XLDnaute Nouveau
Bonjour,

je voudrai savoir si il est possible d'agrémenté ma "Liste_Arômes" avec un useform et que tout les arômes ajouté via ce Useform soit automatiquement disponible dans mes liste en cascade sur mon "Calculateur" ?

serai-ce possible ?

ci-joint classeur démo avec la question qui je l’espère sera claire et concise

Merci de votre aide a venir bonne journée
 

Pièces jointes

  • Copie de E-Tech-Liquides_Démo (3).xlsm
    87.1 KB · Affichages: 45
C

Compte Supprimé 979

Guest
Bonjour Yannick,

Voici ce que j'ai fait, en intégrant ce code dans la feuille [Liste_Arômes]
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FlgFind As Boolean
  Dim Wks As Worksheet
  Dim NLig As Long
  ' Si le changement ne se fait pas dans les Arômes on sort
  If Intersect(Target, Range("D7:D16")) Is Nothing Then Exit Sub
  If Target.Value = "" Then Exit Sub
  ' Définir la feuille source
  Set Wks = ThisWorkbook.Worksheets("Liste_Arômes")
  ' Sinon vérifier que la valeur existe
  On Error Resume Next  ' En cas d'erreur de recherche on continue
  FlgFind = Wks.Range("B:B").Find(What:=Target.Value, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Value <> ""
  On Error GoTo 0
  ' Si la valeur n'a pas été trouvée
  If FlgFind = False Then
    ' On demande s'il faut ajouter l'arôme
    If Msgbox("Cet arôme n'existe pas dans la liste, Voulez-vous l'ajouter ?", _
      vbQuestion + vbYesNo, "AJOUTER AROME ?") = vbYes Then
      ' Lancer l'userform ici
      'UserForm1.Show
 
      ' CE QUI SUIT DEVRA ETRE MIS dans l'USF
      ' Si la réponse est oui, alors, ajouter l'arôme
      ' Trouver la dernière ligne vide
      NLig = Wks.Range("B" & Rows.Count).End(xlUp).Row + 1
      ' Inscrire la marque
      Wks.Range("A" & NLig).Value = Target.Offset(0, -1).Value
      ' Inscrire l'arôme saisi
      Wks.Range("B" & NLig).Value = Target.Value
      ' IMPORTANT - Trier le tableau
      Call TriAromes
    End If
  End If
End Sub

Et dans un module
VB:
Sub TriAromes()
  Dim Dlig As Long  ' Dernière ligne du tableau
  With ThisWorkbook.Worksheets("Liste_Arômes")
    ' Calculer la dernière ligne du tableau
    Dlig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Avec l'objet Tri
    With .Sort
      ' Avec l'objet champs de tri
      With .SortFields
        .Clear
        .Add Key:=Range("A3:A" & Dlig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("B3:B" & Dlig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      End With
      .SetRange Range("A2:AD" & Dlig)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
End Sub

Je te laisse le soin de faire ton USF avec tous les contrôle nécessaires

Voir fichier joint ;)

A+
 

Pièces jointes

  • Yanncik E-Tech-Liquides_Démo.xlsm
    107.3 KB · Affichages: 36
Dernière modification par un modérateur:

Discussions similaires

Statistiques des forums

Discussions
312 152
Messages
2 085 797
Membres
102 978
dernier inscrit
bkarbet