Trier les informations d'une liste déroulante

Toubabou

XLDnaute Impliqué
Bonjour à tous,

J'aimerai pouvoir trier par ordre alphabétiques les informations d'une liste déroulante se trouvant dans une formulaire, dont le ceode se trouve ci-dessous.
Pourriez-vous à nouveau m'aider?

Merci par avance

Voici mon code:

Option Explicit
Dim Coef As Long
Dim ActionSpin As String
Dim ActionList As String

Dim Ws As Worksheet
Dim NbLignes As Integer
Private Sub CommandButton1_Click() 'Quitter
Unload Me
End Sub

Private Sub CommandButton2_Click()
Sheets("COURSES").Activate
Unload Me
End Sub

Private Sub CommandButton3_Click() 'Nouvelle recette
Dim L&, i&, d As Object
If MsgBox("Etes-vous certain de vouloir INSERER cette nouvelle recette ?", vbYesNo, "Demande de confirmation") = vbYes Then
With Ws 'RECETTES
L = .Range("A65536").End(xlUp).Row + 1 'Permet de se positionner sur la dernière ligne de tableau NON VIDE

.Range("A" & L).Value = ComboBox1 'Insère la donnée dans la colonne A
.Range("B" & L).Value = ComboBox2 'Insère la donnée dans la colonne B
'et à suivre....
For i = 1 To 11
.Cells(L, i + 2) = Controls("Textbox" & i)
Next
If [TYPE_PLATS].Find(ComboBox1) Is Nothing Then
Feuil2.Cells(65536, 1).End(3)(2) = ComboBox1
Feuil2.Activate
[TYPE_PLATS].Sort [A1], xlAscending, , , , , , xlNo
Ws.Activate
End If
If [VIN].Find(Textbox9) Is Nothing Then
Feuil2.Cells(65536, 6).End(3)(2) = Textbox9
Feuil2.Activate
[VIN].Sort [F1], xlAscending, , , , , , xlNo
Ws.Activate
End If
ComboBox1.List = [TYPE_PLATS].Value
Textbox9.List = [VIN].Value
MsgBox ("Nouvelle recette inséré. Encore un nouveau plaisir!") 'Vous informe que le présent contact est insérer dans votre tableau Excel.
End With
End If
End Sub
Private Sub CommandButton4_Click() 'Modifier
Dim Ligne&, i&
If MsgBox("Etes-vous certain de vouloir modifier cette recette ?", vbYesNo, "Demande de confirmation") = vbYes Then

If Me.ComboBox1.ListIndex = -1 Then Exit Sub
Ligne = Me.ComboBox2.Column(1)
For i = 1 To 11
If Me.Controls("TextBox" & i).Visible = True Then
Ws.Cells(Ligne, i + 2) = Me.Controls("TextBox" & i)
End If
Next i
End If

End Sub

Private Sub CommandButton5_Click() 'Envoi feuille Impression
Dim Tablo, i&
Sheets("IMPRESSION").Select
[B16:B400].ClearContents
[A2] = ComboBox1: [A3] = ComboBox2
[A6] = Textbox2: [B6] = Textbox4
[A8] = Textbox1: [B8] = Textbox5
[A10] = Textbox3: [B10] = TextBox8
[A12] = Textbox9: [B12] = TextBox11
[A14] = TextBox10: [A16] = TextBox6
Tablo = Split(TextBox7.Text, Chr(10))
For i = LBound(Tablo) To UBound(Tablo)
Cells(i + 16, 2) = Trim(Replace(Tablo(i), Chr(10), ""))
Next i
Rows("16:400").EntireRow.AutoFit
Call InsImage(Image1.Tag, [A4], -1)
Call InsImage(Image2.Tag, [B4], 0)
[A1].Activate
Unload Me
End Sub
Private Sub InsImage(Image$, Cel As Range, Zoom As Boolean)
If Cel <> "" Then ActiveSheet.Shapes.Range(Array(Cel.Value)).Delete
Cel.Activate
Cel = Image
Sheets("IMPRESSION").Pictures.Insert(Image).Select
With Selection
.Name = Image
If Zoom Then
.ShapeRange.LockAspectRatio = msoTrue
.Height = Cel.Height * 0.9
If .Width > Cel.Width * 0.9 Then
.Width = Cel.Width * 0.9
End If
End If
.Top = Cel.Top + ((Cel.Height - .Height) / 2)
.Left = Cel.Left + ((Cel.Width - .Width) / 2)
End With
End Sub
Private Sub CommandButton6_Click()
Worksheets("RECETTES").Visible = True 'Rend visible l'onglet TEST
Worksheets("RECETTES").Activate 'Active l'onglet RECETTES
ActiveSheet.Unprotect ("1124") 'Enlève le mote de passe
Unload Me 'Ferme le formulaire actif
End Sub

Private Sub Image1_Click()

End Sub

Private Sub SpinButton1_SpinUp()
ActionSpin = "Plus"
Reglage
End Sub
Private Sub SpinButton1_SpinDown()
ActionSpin = "Moins"
Reglage
End Sub
Private Sub Reglage()
With Me
Coef = .SpinButton1 - 100
.Height = ((599 / 100) * Coef) + 599 'correspond à la Hauteur de l'userform
.Width = ((993 / 100) * Coef) + 993 'correspond à la largeur de l'userform
.Zoom = .SpinButton1
End With
End Sub
'TITRE du formulaire avec % du zoom
'Facultatif
Private Sub SpinButton1_Change()
'Remarque : l'action Change étant un événement en amont de SpinUp ou SpinDown
Me.Caption = " RECETTES D'ALISON - Zoom à : " & Me.SpinButton1 & " %"
End Sub '-------------------------------------

Private Sub Textbox2_Change()

End Sub

Private Sub Textbox4_Change()

End Sub

Private Sub UserForm_Initialize()
Dim j&, i&, o&, p&, k&, m&, n&, q&
'Ote la croix de l'userform - Code Option Explicit dans module MOT_DE_PASSE
OteCroix Me.Caption

Set Ws = Worksheets("RECETTES")
NbLignes = Ws.Range("A65536").End(xlUp).Row

With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = "-1;0"
End With

With Me.Textbox2
For j = 2 To Ws.Range("d" & Rows.Count).End(xlUp).Row
.AddItem Ws.Range("d" & j)
Next j
End With

Feuil2.Activate
[TYPE_PLATS].Sort [A1], xlAscending, , , , , , xlNo
ComboBox1.List = [TYPE_PLATS].Value
Textbox1.List = [NBRE_PERSONNES].Value
Textbox2.List = [NIVEAU_DIFFICULTE].Value
Textbox3.List = [COUT].Value
Textbox4.List = [TEMPS].Value
Textbox5.List = [TEMPS].Value
[VIN].Sort [F1], xlAscending, , , , , , xlNo
Textbox9.List = [VIN].Value
Ws.Activate
With Me.SpinButton1
.Value = 100 'valeur de base du zoom en %
.Min = 50 'Valeur mini du zoom en %
.Max = 200 'Valeur maxi du zoom en %
End With
Reglage
End Sub
Private Sub ComboBox1_Change() 'Type de plat
Dim j As Long

Nettoyage 'Lance le programme Nettoyage

Me.ComboBox2.Clear 'Efface les données de la combobox2
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
With Me.ComboBox2
For j = 2 To NbLignes
If Ws.Range("A" & j) = Me.ComboBox1 Then
.AddItem Ws.Range("B" & j)
.List(.ListCount - 1, 1) = j
End If
Next j
End With

End Sub
Private Sub ComboBox2_Change() 'Charge recette
Dim Ligne&, i&, MyImage$, Chemin$
On Error GoTo Fin
Nettoyage 'Lance le programme Nettoyage
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
Ligne = Me.ComboBox2.Column(1)
For i = 1 To 11
Me.Controls("TextBox" & i) = Ws.Cells(Ligne, i + 2)
Next i
Label2 = Textbox2

'programmation pour l'affichage des images dans l'userform
Chemin = ThisWorkbook.Path & "\IMAGES\" 'ThisWorkbook.path ... renvoi le répertoire ou est stocké le classeur contenant ton code.

MyImage = ComboBox2 & ".jpg"
If existeFichier(MyImage, Chemin) Then
Image1.Tag = Chemin & MyImage
Image1.Picture = LoadPicture(Image1.Tag) 'Modifiez le CHEMIN par le chemin exacte où se trouve l'image (Ex. : f:\recettes\ )
Else
Image1.Tag = ""
Image1.Picture = LoadPicture(Chemin & "INEXISTANTE.jpg")
End If
MyImage = Textbox2 & ".jpg"
If existeFichier(MyImage, Chemin) Then
Image2.Tag = Chemin & MyImage
Image2.Picture = LoadPicture(Image2.Tag) 'Modifiez le CHEMIN par le chemin exacte où se trouve l'image (Ex. : f:\recettes\ )
Else
Image2.Tag = ""
Image2.Picture = LoadPicture(Chemin & "INEXISTANTE2.jpg")
End If
Fin:
End Sub
Sub Nettoyage()
Dim i As Integer
For i = 1 To 11
Me.Controls("TextBox" & i) = ""
Next i
End Sub


Merci par avance
 

Toubabou

XLDnaute Impliqué
Oups pardon
Alors voici mon code:

Code:
Option Explicit
Dim Coef As Long
Dim ActionSpin As String
Dim ActionList As String

Dim Ws As Worksheet
Dim NbLignes As Integer
Private Sub CommandButton1_Click() 'Quitter
Unload Me
End Sub

Private Sub CommandButton2_Click()
Sheets("COURSES").Activate
Unload Me
End Sub

Private Sub CommandButton3_Click() 'Nouvelle recette
Dim L&, i&, d As Object
If MsgBox("Etes-vous certain de vouloir INSERER cette nouvelle recette ?", vbYesNo, "Demande de confirmation") = vbYes Then
  With Ws 'RECETTES
   L = .Range("A65536").End(xlUp).Row + 1 'Permet de se positionner sur la dernière ligne de tableau NON VIDE
  
    .Range("A" & L).Value = ComboBox1 'Insère la donnée  dans la colonne A
   .Range("B" & L).Value = ComboBox2 'Insère la donnée  dans la colonne B
   'et à suivre....
   For i = 1 To 11
      .Cells(L, i + 2) = Controls("Textbox" & i)
    Next
    If [TYPE_PLATS].Find(ComboBox1) Is Nothing Then
      Feuil2.Cells(65536, 1).End(3)(2) = ComboBox1
      Feuil2.Activate
      [TYPE_PLATS].Sort [A1], xlAscending, , , , , , xlNo
      Ws.Activate
    End If
    If [VIN].Find(Textbox9) Is Nothing Then
      Feuil2.Cells(65536, 6).End(3)(2) = Textbox9
      Feuil2.Activate
      [VIN].Sort [F1], xlAscending, , , , , , xlNo
      Ws.Activate
    End If
  ComboBox1.List = [TYPE_PLATS].Value
  Textbox9.List = [VIN].Value
  MsgBox ("Nouvelle recette inséré. Encore un nouveau plaisir!") 'Vous informe que le présent contact est insérer dans votre tableau Excel.
End With
End If
End Sub
Private Sub CommandButton4_Click() 'Modifier
Dim Ligne&, i&
If MsgBox("Etes-vous certain de vouloir modifier cette recette ?", vbYesNo, "Demande de confirmation") = vbYes Then

  If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  Ligne = Me.ComboBox2.Column(1)
    For i = 1 To 11
      If Me.Controls("TextBox" & i).Visible = True Then
        Ws.Cells(Ligne, i + 2) = Me.Controls("TextBox" & i)
      End If
    Next i
  End If

End Sub

Private Sub CommandButton5_Click() 'Envoi feuille Impression
Dim Tablo, i&
  Sheets("IMPRESSION").Select
  [B16:B400].ClearContents
  [A2] = ComboBox1: [A3] = ComboBox2
  [A6] = Textbox2: [B6] = Textbox4
  [A8] = Textbox1: [B8] = Textbox5
  [A10] = Textbox3: [B10] = TextBox8
  [A12] = Textbox9: [B12] = TextBox11
  [A14] = TextBox10: [A16] = TextBox6
  Tablo = Split(TextBox7.Text, Chr(10))
  For i = LBound(Tablo) To UBound(Tablo)
    Cells(i + 16, 2) = Trim(Replace(Tablo(i), Chr(10), ""))
  Next i
  Rows("16:400").EntireRow.AutoFit
  Call InsImage(Image1.Tag, [A4], -1)
  Call InsImage(Image2.Tag, [B4], 0)
  [A1].Activate
  Unload Me
End Sub
Private Sub InsImage(Image$, Cel As Range, Zoom As Boolean)
  If Cel <> "" Then ActiveSheet.Shapes.Range(Array(Cel.Value)).Delete
  Cel.Activate
  Cel = Image
  Sheets("IMPRESSION").Pictures.Insert(Image).Select
  With Selection
  .Name = Image
    If Zoom Then
      .ShapeRange.LockAspectRatio = msoTrue
      .Height = Cel.Height * 0.9
      If .Width > Cel.Width * 0.9 Then
        .Width = Cel.Width * 0.9
      End If
    End If
    .Top = Cel.Top + ((Cel.Height - .Height) / 2)
    .Left = Cel.Left + ((Cel.Width - .Width) / 2)
  End With
End Sub
Private Sub CommandButton6_Click()
  Worksheets("RECETTES").Visible = True 'Rend visible l'onglet TEST
Worksheets("RECETTES").Activate  'Active l'onglet RECETTES
ActiveSheet.Unprotect ("1124") 'Enlève le mote de passe
Unload Me 'Ferme le formulaire actif
End Sub

Private Sub Image1_Click()

End Sub

Private Sub SpinButton1_SpinUp()
  ActionSpin = "Plus"
  Reglage
End Sub
Private Sub SpinButton1_SpinDown()
  ActionSpin = "Moins"
  Reglage
End Sub
Private Sub Reglage()
  With Me
    Coef = .SpinButton1 - 100
    .Height = ((599 / 100) * Coef) + 599 'correspond à la Hauteur de l'userform
   .Width = ((993 / 100) * Coef) + 993 'correspond à la largeur de l'userform
   .Zoom = .SpinButton1
  End With
End Sub
'TITRE du formulaire avec % du zoom
'Facultatif
Private Sub SpinButton1_Change()
  'Remarque : l'action Change étant un événement en amont de SpinUp ou SpinDown
Me.Caption = "    RECETTES D'ALISON          -          Zoom à : " & Me.SpinButton1 & " %"
End Sub '-------------------------------------

Private Sub Textbox2_Change()

End Sub

Private Sub Textbox4_Change()

End Sub

Private Sub UserForm_Initialize()
Dim j&, i&, o&, p&, k&, m&, n&, q&
'Ote la croix de l'userform - Code Option Explicit dans module MOT_DE_PASSE
OteCroix Me.Caption

Set Ws = Worksheets("RECETTES")
NbLignes = Ws.Range("A65536").End(xlUp).Row
With Me.ComboBox2
  .ColumnCount = 2
  .ColumnWidths = "-1;0"
End With
With Me.Textbox2
  For j = 2 To Ws.Range("d" & Rows.Count).End(xlUp).Row
    .AddItem Ws.Range("d" & j)
  Next j
End With

Feuil2.Activate
  [TYPE_PLATS].Sort [A1], xlAscending, , , , , , xlNo
  ComboBox1.List = [TYPE_PLATS].Value
  Textbox1.List = [NBRE_PERSONNES].Value
  Textbox2.List = [NIVEAU_DIFFICULTE].Value
  Textbox3.List = [COUT].Value
  Textbox4.List = [TEMPS].Value
  Textbox5.List = [TEMPS].Value
  [VIN].Sort [F1], xlAscending, , , , , , xlNo
  Textbox9.List = [VIN].Value
Ws.Activate
With Me.SpinButton1
  .Value = 100          'valeur de base du zoom en %
.Min = 50    'Valeur mini du zoom en %
.Max = 200   'Valeur maxi du zoom en %
End With
Reglage
End Sub
Private Sub ComboBox1_Change() 'Type de plat
Dim j As Long

  Nettoyage    'Lance le programme Nettoyage

  Me.ComboBox2.Clear   'Efface les données de la combobox2
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  With Me.ComboBox2
    For j = 2 To NbLignes
      If Ws.Range("A" & j) = Me.ComboBox1 Then
        .AddItem Ws.Range("B" & j)
        .List(.ListCount - 1, 1) = j
      End If
    Next j
  End With
End Sub
Private Sub ComboBox2_Change() 'Charge recette
Dim Ligne&, i&, MyImage$, Chemin$
On Error GoTo Fin
  Nettoyage 'Lance le programme Nettoyage
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
  Ligne = Me.ComboBox2.Column(1)
  For i = 1 To 11
    Me.Controls("TextBox" & i) = Ws.Cells(Ligne, i + 2)
  Next i
Label2 = Textbox2

'programmation pour l'affichage des images dans l'userform
Chemin = ThisWorkbook.Path & "\IMAGES\" 'ThisWorkbook.path ... renvoi le répertoire ou est stocké le classeur contenant ton code.

MyImage = ComboBox2 & ".jpg"
If existeFichier(MyImage, Chemin) Then
  Image1.Tag = Chemin & MyImage
  Image1.Picture = LoadPicture(Image1.Tag) 'Modifiez le CHEMIN par le chemin exacte où se trouve l'image  (Ex. :  f:\recettes\   )
Else
  Image1.Tag = ""
  Image1.Picture = LoadPicture(Chemin & "INEXISTANTE.jpg")
End If
MyImage = Textbox2 & ".jpg"
If existeFichier(MyImage, Chemin) Then
  Image2.Tag = Chemin & MyImage
  Image2.Picture = LoadPicture(Image2.Tag) 'Modifiez le CHEMIN par le chemin exacte où se trouve l'image  (Ex. :  f:\recettes\   )
Else
  Image2.Tag = ""
  Image2.Picture = LoadPicture(Chemin & "INEXISTANTE2.jpg")
End If
Fin:
End Sub
Sub Nettoyage()
Dim i As Integer
  For i = 1 To 11
    Me.Controls("TextBox" & i) = ""
  Next i
End Sub
 

Discussions similaires

Réponses
23
Affichages
836
Haut Bas