Formulaire sous excel VBA

Question

Bonjour, J'ai à remplire une feuille excel avec des données. Mes colonnes s'appellent comme suit : "Type" "N° EAB" "N° Voiture" "MOTIF" "date butée" "Date référence" "n° d'ordre" "COT" "Faire Apparaître" J'ai pensé alors à faire un formulaire après le conseil d'un membre du forum et ce qui m'interesse est le suivant: 1. Je saisie le "Type" dans une liste déroulante, et il me permet d'avoir les "n° EAB" correspondant qui sera aussi dans une liste déroulante. Et quand je choisis le "n° EAB" il me permet d'avoir : --> une liste des "n° Voiture" qui sera alors une liste de selections multiples --> une liste des "Motif" qui sera aussi une liste de selections multiples 2. Quand je fais la selection dans "Motif", des fois j'ai à rentrer d'autre données qui n'appartiennent pas à cette liste. (vu que chaque n°voiture a qlqs "motif" particuliers qui seront saisis à la main Et avant de valider la selection je dois parcourir plusieurs fichiers excel d'un dossier pour voir si jamais j'ai deja les memes informations saisies dans des "date référence" differentes de celle que je vais saisir. (dans le cas positif : je dois avoir un avertissement qui me signal "Attention cette voiture avait deja ce motif dans une periode de.." NB: Je ne sais pas fair le parcours des fichiers/les cherches/ les ouvrir et comparer leurs données puis les fermer 3. Si je saisie une selection de la case "MOTIF", la colonne "COT" doit contenir un "OUI" et "NON" si aucune données de cette liste n'est saisie. 4. Les autres champs qui restent se remplissent à la main. J'ai pas mal pensé, mais vu que je suis encore au début je n'ai pas vraiement réussi à faire grande chose. J'ai créé le formulaire et je suis arrivée jusqu'à la selection multiple de "MOTIF" Private Sub UserForm_Initialize() Set f = Sheets("BD") Set mondico = CreateObject("Scripting.Dictionary") For Each c In Range(f.[A2], f.[A65000].End(xlUp)) mondico(c.Value) = c.Value Next c temp = mondico.items Call Tri(temp, LBound(temp), UBound(temp)) Me.ComboBox1.List = temp End Sub Private Sub ComboBox1_Change() Set mondico = CreateObject("Scripting.Dictionary") For Each c In Range(f.[A2], f.[A65000].End(xlUp)) If c Me.ComboBox1 Then mondico(c.Offset(, 1).Value) c.Offset(, 1).Value Next c temp = mondico.items Call Tri(temp, LBound(temp), UBound(temp)) Me.ComboBox2.List = temp Me.ComboBox2.ListIndex = -1 Me.ListBox1.ListIndex = -1 End Sub Private Sub ComboBox2_Change() Set mondico = CreateObject("Scripting.Dictionary") For Each c In Range(f.[A2], f.[A65000].End(xlUp)) If c Me.ComboBox1 And c.Offset(, 1) Me.ComboBox2 Then mondico(c.Offset(, 2)) = c.Offset(, 2) Next c If mondico.Count > 0 Then temp = mondico.items Call Tri(temp, LBound(temp), UBound(temp)) Me.ListBox1.List = temp Me.ListBox1.ListIndex = -1 Me.ListBox1.MultiSelect = fmMultiSelectMulti Me.ListBox1.List = temp Me.ListBox2.ListIndex = -1 'Me.ListBox2.List = Range(f.[E1], f.[E65000].End(xlUp)) Me.ListBox2.MultiSelect = fmMultiSelectMulti End If End Sub Private Sub ListBox1_Change() mondico.RemoveAll For Each c In Range(f.[B2], f.[B65000].End(xlUp)) For k = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.Selected(k) = True Then If c = Me.ListBox1.List(k, 0) Then Me.ListBox2.AddItem c.Offset(, 1) End If Next k Next c End Sub Private Sub ListBox2_Click() Me.ListBox3.Clear Me.ListBox2.List = Range(f.[E1], f.[E65000].End(xlUp)) Set mondico = CreateObject("Scripting.Dictionary") For Each c In Me.ListBox2.List For k = 0 To Me.ListBox2.ListCount - 1 If Me.ListBox2.Selected(k) = True Then If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1) End If End If Next k Next c MsgBox temp End Sub Private Sub Ajouter_Click() temp = "" For k = 0 To Me.ListBox3.ListCount - 1 If Me.ListBox3.Selected(k) True Then temp temp & Me.ListBox3.List(k, 0) & " " Next k ActiveCell = temp Unload Me End Sub Sub Tri(a, gauc, droi) ' Quick sort ref = a((gauc + droi) \ 2) g gauc: d droi Do Do While a(g) < ref: g = g + 1: Loop Do While ref < a(d): d = d - 1: Loop If g <= d Then temp a(g): a(g) a(d): a(d) = temp g g + 1: d d - 1 End If Loop While g <= d If g < droi Then Call Tri(a, g, droi) If gauc < d Then Call Tri(a, gauc, d) End Sub Merci d'avance Safounette Be The Change in this world :)

jordane45 · Answer

Bonjour,

NB: Je ne sais pas fair le parcours des fichiers/les cherches/ les ouvrir et comparer leurs données puis les fermer 

Pour parcourir des répertoire à la recherche de fichiers tu peux passer par le FileSearch.
NB: Sous Office 2007, cette fonction n'existe plus. Tu peux quand même la "remettre" en utilisant une classer personnalisée: voir : complément FileSearch pour Excel 2007

Sous 2003 : 


Sub test()

' recherche des fichiers :
With Application.FileSearch
    .LookIn = "D:"
    .Filename = "*.*" ' Nom des fichiers à chercher
    .FileType = msoFileTypeExcelWorkbooks ' types de fichiers
    .SearchSubFolders = False 'recherche dans sous dossiers
    .Execute
       
    NbFichiers = .FoundFiles.Count

' Parcourir la liste
For j = 1 To NbFichiers
    ' affichage dans fenetre du débugeur.
    Debug.Print .FoundFiles(j)
    ' Ouverture du classeur
    Workbooks.Open (.FoundFiles(j))
    
    '/////////////////////////
    ' Ici code pour comparer
    '/////////////////////////
    
    
    'Fermeture du classeur
    Workbooks(.FoundFiles(j)).Close
       
Next
    
End With

End Sub


Il ne te reste plus qu'à faire le code pour comparer tes données.



Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

Formulaire sous excel VBA

1 réponse

Votre réponse

Discussions similaires