Problème d'ajouts de références dans une base de données (VBA Excel)
Bonjour, je suis débutant avec excel VBA, j'ai donc quelques questions pour les experts que vous êtes.
Vous trouverez dans le fichier uploader la feuille base de données qui dans le futur permettra d'ajouter/modifier/supprimer des références.
Avec le bouton ajouter, je peux rentrer plusieurs infos concernant une nouvelle référence. Mais j'ai plusieurs soucies :
- Tout d'abord même avec un "Unload me", mon UserForm s'ouvre en étant déjà remplis et je voudrais qu'il soit vide
- Ensuite, j'ai essayé d'implémenter un remplissage automatique en fonction de la marque sélectionné
Cependant ayant voulu supprimer les doublons, je pense n'accès qu'à la première ligne de la marque sélectionné (Je vais donc devoir faire une combobox en cascade)
- Enfin, pour le trie, j'ai implémenté une seule option pour le moment (trie pas marque), cependant, je n'ai pas réussi dans le code à faire une boucle if en indiquant que le mot "Marque" avait été sélectionné dans ce même UserForm.
Dans l'attente de vos réponses.
Salut,
Pour le point 1.
Déclare, tout en haut de ton module :
Private InhibeEvent As BooleanEnsuite, ton événement Combobox1_Change() :
Private Sub ComboBox1_change()
'permet le remplissage, suite à la sélection d'un item, de ses caractéristiques dans la boite d'ajout
Set ws = Sheets("Base_de_données")
Dim ligne As Long
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
If Not InhibeEvent Then
ligne = Me.ComboBox1.ListIndex + 2
Me.TextBox2 = ws.Cells(ligne, "B")
Me.TextBox3 = ws.Cells(ligne, "C")
Me.TextBox4 = ws.Cells(ligne, "D")
Me.TextBox5 = ws.Cells(ligne, "E")
Me.TextBox6 = ws.Cells(ligne, "F")
End If
End SubEt enfin Userform_Initialize()
Private Sub UserForm_Initialize()
'permet la sélection dans un menu déroulant des items déjà présent dans la base de données
Set ws = Sheets("Base_de_données")
Dim j As Integer
InhibeEvent = True
With Me.ComboBox1
For j = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
ComboBox1 = Range("A" & j)
'Supprime les doublons de la colonne A dans le combobox1
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Range("A" & j)
Next j
End With
InhibeEvent = False
End SubPour le reste, je n'ai pas tout compris...
Pour le 2. Ajout d'un SpinButton horizontal :
Pour le 3. le + simple est d'utiliser le tri d'Excel non?
Salut,
Merci beaucoup pour tes retours.
-J'ai effectué les modifications et mon UserForm est bien vide lors de l'ouverture. Serait il cependant possible de n'afficher aucun marque de base dans la fenêtre?
-En ce qui concerne le tri, je pense utiliser les fonctions excels, et de les lier dans mon UserForm TRIER, j'aimerai donc savoir comment dans ma fonction qui suit, permettre au code de savoir quel trie faire.
'If "Marque" Then
With ActiveWorkbook.Worksheets("Base_de_données").Sort
.SetRange Range("A1:F65536")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'End If-Pour implémenter une fonction recherche (avec un pop-up) regroupant un tableau avec la marque ou le produit ciblé, quelles fonctions me recommenderais-tu?
Merci d'avance
Je viens de tester ton SpinButton, c'est excellent.
Cependant lorsqu'aucune marque n'est sélectionné, le Spin part en sucette, je regarde ce que je peux faire.
Pour éviter l'effet "sucette" :
Private Sub SpinButton1_Change()
Dim L As Long
If ComboBox1.Text <> vbNullString Then
L = SpinButton1.Value + 1
If L >= LBound(FilteredDatas, 1) And L <= UBound(FilteredDatas, 1) Then
Ligne = SpinButton1.Value + 1
Me.TextBox2 = FilteredDatas(Ligne, 2)
Me.TextBox3 = FilteredDatas(Ligne, 3)
Me.TextBox4 = FilteredDatas(Ligne, 4)
Me.TextBox5 = FilteredDatas(Ligne, 5)
Me.TextBox6 = FilteredDatas(Ligne, 6)
Else
SpinButton1.Value = SpinButton1.Value - 1
End If
End If
End SubPar contre, il faudra changer le code de ton bouton "MODIFIER".
Qu'elles sont les valeurs susceptibles d'être modifiées?
En fait, avec tous les doublons, il faut que l'on puisse facilement déterminer la ligne. En général, pour cela, on utilise une colonne à droite avec un numéro unique...
A tester avec ID :
Oui je comprends que le bouton modifier n'est pas optimisé. pour le numéro "unique", penses-tu qu'il faudrait une base du style 001 pour la marque KIMO par exemple et 00001 pour cibler que c'était la première référence ajouter? ce qui donnerrai dans une colonne 00100001.
Cela permettrait peut-être pour de futurs évolutions une recherche assez poussé dans la base de données.
Ou un numéro basique en fonction de son moment d'ajout suffira (0001, 0002, etc)
A terme, tu prévois combien de lignes dans ta bdd?
Pour moi : un numéro basique en fonction de son moment d'ajout suffira (0001, 0002, etc)
EDIT : Quelques modifications mineures dans le code :
Re Franck,
Pour ce qui est de la taille des bdd, elles n'auront jamais plus de 2000 ref car je les scinderai en plusieurs feuilles suivant différents types.
Tu as répondu à mes questions de mon premier poste et je t'en suis très reconnaissant.
Si je souhaite poursuivre avec un item et des questions sur la recherche de données dans mon tableau, dois-je recréer un sujet ou poursuivre ici?
Il reste la partie trie, oops
En exemple le trie par marque mais j'aimerai aussi implémenter le tri par produit et ID. La sélection des colonnes j'en fais mon affaire, mais la prise en compte de ces différentes options avec les indicateurs "Marque" etc ..., j'ai besoins d'aide.
'If "Marque" Then
With ActiveWorkbook.Worksheets("Base_de_données").Sort
.SetRange Range("A1:F65536")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'End IfBonjour,
Voici le code de l'UserForm de tri :
Private Sub ComboBox1_AfterUpdate()
Dim Datas, DL As Long
With ThisWorkbook.Worksheets("Base_de_données")
DL = .Range("B" & .Rows.Count).End(xlUp).Row
Datas = .Range("A2:G" & DL).Value
If ComboBox1.ListIndex <> -1 Then
QuickSortArray Datas, LBound(Datas, 1), UBound(Datas, 1), ComboBox1.ListIndex + 1
.Range("A2").Resize(UBound(Datas, 1), UBound(Datas, 2)).Value = Datas
End If
End With
End Sub
Private Sub CommandButton1_Click()
'ferme la fenetre en vidant son contenu
Unload Me
End Sub
Private Sub CommandButton2_Click()
'rafraichir la fenetre de saisie
ComboBox1.Text = vbNullString
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
'permet la sélection dans un menu déroulant des items déjà présent dans la base de données
With ThisWorkbook.Sheets("Base_de_données")
For i = 1 To 7
ComboBox1.AddItem .Cells(1, i).Value
Next
End With
End Sub
Private Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
On Error Resume Next
'Sort a 2-Dimensional array
' SampleUsage: sort arrData by the contents of column 3
' QuickSortArray arrData, , , 3
'Posted by Jim Rech 10/20/98 Excel.Programming
'Modifications, Nigel Heffernan:
' ' Escape failed comparison with empty variant
' ' Defensive coding: check inputs
Dim i As Long, j As Long, varMid As Variant, arrRowTemp As Variant, lngColTemp As Long
If IsEmpty(SortArray) Then
Exit Sub
End If
If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name
Exit Sub
End If
If lngMin = -1 Then
lngMin = LBound(SortArray, 1)
End If
If lngMax = -1 Then
lngMax = UBound(SortArray, 1)
End If
If lngMin >= lngMax Then ' no sorting required
Exit Sub
End If
i = lngMin
j = lngMax
varMid = Empty
varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)
' We send 'Empty' and invalid data items to the end of the list:
If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
i = lngMax
j = lngMin
ElseIf IsEmpty(varMid) Then
i = lngMax
j = lngMin
ElseIf IsNull(varMid) Then
i = lngMax
j = lngMin
ElseIf varMid = "" Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) = vbError Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) > 17 Then
i = lngMax
j = lngMin
End If
While i <= j
While SortArray(i, lngColumn) < varMid And i < lngMax
i = i + 1
Wend
While varMid < SortArray(j, lngColumn) And j > lngMin
j = j - 1
Wend
If i <= j Then
' Swap the rows
ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
Next lngColTemp
Erase arrRowTemp
i = i + 1
j = j - 1
End If
Wend
If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
End SubBonjour, c'est exactement ce que je voulais faire avec cette option de tri.
Depuis ce matin, je me suis lancé dans une fenêtre/formulaire permettant une recherche et un affichage des résultats au seins de la même fenêtre.
Je me retrouve à faire un deuxième tableau sur une deuxième feuille pour ensuite le reporter dans mon UserForm de recherche. Yaurait-il possibilité de faire autrement?
Je vais reUploader mon fichier pour montrer mon avancement.
Merci d'avance.
Tu avais quasiment toutes les fonctions utiles.
Suffisait de comprendre le principe avec les Array et modifier la fonction filtr.
Je t'ai mis les fonctions utiles dans un module à part.
Voici ton fichier :
J'aimerai rendre les entêtes visibles dans mon UserForme recherche. J'ai réussis à les fixer, mais encore faut-il les remplir.
Private Sub ComboBox1_Change()
inhibeEvent = True
Me.TextBox1.Value = ""
Set bddFeuil1 = Feuil1.[A1].CurrentRegion
Me.ListBox2.ColumnHeads = True
'Me.ListBox2.
inhibeEvent = False
Call FillEntireDatas(bddFeuil1)
If ComboBox1.ListIndex <> -1 Then
colonne = ComboBox1.ListIndex + 1
End If
End SubEt je n'ai pas tout compris dans la fonction recherche encore, je vais me pencher dessus car 3 petits problèmes subsistes.
Pas de détection des chiffres pour les recherche, ni de minuscules et l'ordre des lettres inscrites dans la textebox n'importent pas pour le moment ce qui est un peu embêtant.
Je pensais que le symbole "*" permettait d'afficher des résultats sans mots entier et non pas une recherche par caractère.
Merci pour tes retours en tout cas :)
Je viens de comprendre que le mot clé était forcément lié au critère MARQUE, donc les chiffres et minuscules sont bien pris en comptes.
Pour ce qui concerne la recherche, j'ai volontairement choisi de ne pas considérer l'ordre des caractères saisis.
De plus, la casse était prise en compte. Si tu ne souhaites que les majuscules, aucun souci.
Remplace, dans le module de l'UserForm de recherche, la code de TextBox1_Change() par :
Private Sub TextBox1_Change()
If Not inhibeEvent Then
If ComboBox1.ListIndex <> -1 Then
If colonne > 0 Then
TbFiltre = filtr(bddFeuil1, 2, TextBox1.Text & "*")
If IsArrayAllocated(TbFiltre) Then
ListBox2.List = TbFiltre
End If
End If
End If
End If
End SubPour la propriété ColumnHeads, la solution est de passer par un RowSource. Et donc, une feuille supplémentaire pour les filtres...
Sinon, plus simple, tu places des Labels au dessus de ta ListBox, avec, dans leurs propriétés Caption, les entêtes de tes colonnes...
C'est ce que j'étais de train de faire, c'est rustique d'un côté mais j'aurais un seul tableau.
Par contre saurais-tu pourquoi ma recherche une fois ma combobox remplis ne prend en compte que "MARQUE qu'importe l'item sélectionné dans cette même combobox? C'est comme si il ne lisait que la colonne B.
Oups. Pardon... J'ai omis d'intégrer le numéro de colonne...
Remplacer, à nouveau, le TextBox1_Change() par : (modif : colonne au lieu de 2 dans l'appel du filtre)
Private Sub TextBox1_Change()
If Not inhibeEvent Then
If ComboBox1.ListIndex <> -1 Then
If colonne > 0 Then
TbFiltre = filtr(bddFeuil1, colonne, TextBox1.Text & "*")
If IsArrayAllocated(TbFiltre) Then
ListBox2.List = TbFiltre
End If
End If
End If
End If
End SubAucune raison d'être désolé, c'est plutôt moi qui le suis avec mes questions bête ou simple, tout dépend le point de vue!
Un grand merci en tout cas, tout est fonctionnel.
Bonne continuation