[VBA] Rajouter une fonction modifier avec une fonction de cascade
Sur ma version j'avais effacé le rowsource par la suite;
Je vais me pencher sur ton code j'ai un message d'erreur : Erreur d'execution '424' : objet requis.
vérifier les noms de contrôles et aussi les noms des feuilles et si ils existent vraiment !
Ok je vais checker tout ça
Je reviens vers toi pour te dire ce qu’il en est merci beaucoup
Voilà où j'en suis, j'ai rajouté une fonction à mon bouton Modifier
Dim Ws 'OU Dim Trsblt 'à déclarer en haut de module
'à déclarer en haut de module
Private Sub CommandButton2_Click()
Dim no_ligne As Integer
Sheets("TRACABILITE M.A.E").Select
no_ligne = ComboBox7.ListIndex + 2
If ComboBox7.Value = "" Then
MsgBox ("Veuillez renseigner votre numéro de lot ainsi que le nom et prénom du patient.")
Else
Cells(no_ligne, 2) = ComboBox5.Value
Cells(no_ligne, 3) = TextBox7.Value
Cells(no_ligne, 4) = TextBox8.Value
Cells(no_ligne, 6) = TextBox9.Value
Cells(no_ligne, 7) = ComboBox6.Value
End If
TextBox8.Text = "jj/mm/aaaa"
End Sub
'recherche numero lot'
Private Sub UserForm_Initialize()
Dim tbl, m As Integer
m = 0
ReDim tbl(m)
'OU Set Trsblt = Sheets("TRACABILITE M.A.E")
Set Ws = Sheets("TRACABILITE M.A.E")
ComboBox4.Clear
drlgn = Ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = drlgn To 2 Step -1
n = Application.CountIf(Ws.Range("a" & i & ":a" & drlgn), Ws.Cells(i, 1))
If n = 1 Then
ReDim Preserve tbl(m)
tbl(m) = Val(Ws.Cells(i, 1)): m = m + 1
End If
Next
For b = 1 To 26
For j = 0 To m - 1
If tbl(j) = b Then ComboBox4.AddItem b: Exit For
Next
Next
TextBox3.Text = "jj/mm/aaaa"
End Sub
'nom&prénom en fonction du num lot'
Private Sub ComboBox4_Change()
ComboBox7.Clear
drlgn = Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To drlgn
If ComboBox4.Text = Ws.Cells(j, 1) Then ComboBox7.AddItem Ws.Cells(j, "E")
Next
End Sub
Private Sub ComboBox7_Change()
Dim ligne As Range
If ComboBox7.ListIndex = -1 Then
Exit Sub
Controls("Combobox5").ListIndex = -1
Controls("textbox7") = ""
Controls("textbox8") = ""
Controls("textbox9") = ""
Controls("combobox6").ListIndex = -1
End If
With Ws
Set ligne = .Columns("E").Find(ComboBox7.Value, LookIn:=xlValues) 'set
'tu cherche ComboBox7.Value dans la colonne 2=B qui est pour "SERVICE DEMANDEUR"
'alors que tu doit le cherche sur la colonne 5 == "E"
'tu peux utiliser cette methode = .Cells(1, "B")
If Not ligne Is Nothing Then ligne = ComboBox7.ListIndex + 1
MsgBox ligne.Address 'tu peux l effacer apres cest juste pour verifier
Controls("Combobox5").AddItem .Cells(ligne.Row, 2)
Controls("Combobox5").ListIndex = 0
Controls("textbox7") = .Cells(ligne.Row, 3) '.Cells(1, "Bla bla")
Controls("textbox8") = .Cells(ligne.Row, 4) '.Cells(1, "C")
Controls("textbox9") = .Cells(ligne.Row, 6) '.Cells(1, "Bla bla")
Controls("combobox6").AddItem .Cells(ligne.Row, 7) '.AddItem
Controls("combobox6").ListIndex = 0
End With
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
If ComboBox3 = "" Or ComboBox1 = "" Or TextBox3 = "" Or TextBox3 = "jj/mm/aaaa" Or TextBox4 = "" Then
MsgBox ("Il manque une information obligatoire")
Else
If Sheets("TRACABILITE M.A.E").Range("a2") = "" Then
Sheets("TRACABILITE M.A.E").Range("a2") = TextBox1
Else
Sheets("TRACABILITE M.A.E").ListObjects(1).ListRows.Add
End If
'dlt fin de tableau a1048576 cellule bas max puis remonter derniere cellule pleine'
dlt = Sheets("TRACABILITE M.A.E").Range("a1048576").End(xlUp).Row
Sheets("TRACABILITE M.A.E").Range("a" & dlt) = ComboBox3
Sheets("TRACABILITE M.A.E").Range("b" & dlt) = ComboBox1
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("c" & dlt) = TextBox3.Value
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("e" & dlt) = TextBox4
Sheets("TRACABILITE M.A.E").Range("f" & dlt) = TextBox5
Sheets("TRACABILITE M.A.E").Range("g" & dlt) = ComboBox2
Unload UserForm1
End If
End Sub
Private Sub TextBox3_AfterUpdate()
On Error GoTo messagerreur
TextBox3 = Format(TextBox3, "short date")
Exit Sub
messagerreur:
MsgBox ("Le format n'est pas valide, le format de date est Jour/Mois/Année.")
TextBox3 = Empty
End Sub
Private Sub TextBox3_Enter()
If TextBox3 = "jj/mm/aaaa" Then
TextBox3 = ""
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox3 = "" Then
TextBox3 = "jj/mm/aaaa"
End If
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not ((KeyAscii > 46 And KeyAscii < 58)) Then
KeyAscii = 0
End If
End SubPlusieurs erreurs d'execution :
1) La fonction de recherche de Lot et Nom et prénom est fonctionnelle, mais il remplace certaines données du tableau.
Exemple : je sélectionne un lot et un patient; théoriquement il devrait uniquement sélectionner E7 sans rien faire, mais il met un message $E$4 et modifier cette cellule en mettant un chiffre 1.
2) L'execution de mon bouton modifie des cellules. Mais uniquement la premiere ligne et change logiquement toute la ligne.
3) Le pré-remplissage des combobox/textbox est donc erroné
Merci
J'apporte plus de précision après X essais.
La fonction Recherche de Lot et Nom & Prénoms associé fonctionnent.
Le problème apparait quand je sélectionne le nom-prenom dans la liste. 1 apparait dans la cellule concernée. Des fois cela selectionne une autre cellule qui n'a rien à voir et je n'arrive pas à cerner le probleme.
J'ai coupé en deux UserForm. Le probleme concerné est dans Userform2.
Salut
j ai changé plusieurs chose , copie a nouveau ce code sur userform1
autre chose : je n'ai pas pris en considération ton dernier message et je n ai pas vu ton dernier fichier , juste copies le code comme avant dans userform1 de l ancien fichier (orignal)et dit moi si tous fonctionnent bien
Dim Ws 'OU Dim Trsblt 'à déclarer en haut de module
Dim tbl
Sub msAjr(NloTs)
Dim m As Integer
'--------#############--------
If ComboBox4.ListIndex = -1 Or ComboBox4.Text = "" Then Exit Sub
drlgn = Ws.Cells(Rows.Count, "A").End(xlUp).Row
n = Application.CountIf(Ws.Range("A2:A" & drlgn), NloTs)
ReDim tbl(n - 1, 11)
For i = 2 To drlgn
If Ws.Cells(i, "A") = NloTs Then
For col = 1 To 10 '10 = N² de derniere colonne contient les données
tbl(m, col - 1) = Ws.Cells(i, col)
tbl(m, 10) = i '9 + 1 = 10
Next
m = m + 1
End If
Next
'--------#############--------
End Sub
Private Sub CommandButton2_Click()
Dim no_ligne As Integer
If ComboBox4.Value = "" Or ComboBox4.ListIndex = -1 Then
MsgBox ("Veuillez renseigner votre numéro de lot ainsi que le nom et prénom du patient.")
Exit Sub
End If
If ComboBox7.Value = "" Or ComboBox7.ListIndex = -1 Then
MsgBox ("Veuillez renseigner votre numéro de lot ainsi que le nom et prénom du patient.")
Exit Sub
End If
no_ligne = tbl(ComboBox7.ListIndex, 10)
Ws.Cells(no_ligne, 2) = ComboBox5.Value
Ws.Cells(no_ligne, 3) = TextBox7.Value
Ws.Cells(no_ligne, 4) = TextBox8.Value
Ws.Cells(no_ligne, 6) = TextBox9.Value
Ws.Cells(no_ligne, 7) = ComboBox6.Value
End Sub
'recherche numero lot'
Private Sub UserForm_Initialize()
Dim tmps, m As Integer
m = 0
ReDim tmps(m)
'OU Set Trsblt = Sheets("TRACABILITE M.A.E")
Set Ws = Sheets("TRACABILITE M.A.E")
ComboBox4.Clear
drlgn = Ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = drlgn To 2 Step -1
n = Application.CountIf(Ws.Range("a" & i & ":a" & drlgn), Ws.Cells(i, 1))
If n = 1 Then
ReDim Preserve tmps(m)
tmps(m) = Val(Ws.Cells(i, 1)): m = m + 1
End If
Next
For b = 1 To 26
For j = 0 To m - 1
If tmps(j) = b Then ComboBox4.AddItem b: Exit For
Next
Next
TextBox3.Text = "jj/mm/aaaa"
End Sub
'nom&prénom en fonction du num lot'
Private Sub ComboBox4_Change()
ComboBox7.Clear
Call msAjr(Val(ComboBox4.Text))
For i = 0 To UBound(tbl)
ComboBox7.AddItem tbl(i, 4)
Next
End Sub
Private Sub ComboBox7_Change()
Dim ligne
If ComboBox7.ListIndex = -1 Then
Controls("Combobox5").Clear
Controls("textbox7") = ""
Controls("textbox8") = ""
Controls("textbox9") = ""
Controls("combobox6").Clear
Exit Sub
End If
With Ws
'-----####################--------------------
ligne = ComboBox7.ListIndex
Controls("Combobox5").AddItem tbl(ligne, 1)
Controls("Combobox5").ListIndex = 0
Controls("textbox7") = tbl(ligne, 2)
Controls("textbox8") = tbl(ligne, 3)
Controls("textbox9") = tbl(ligne, 5)
Controls("combobox6").AddItem tbl(ligne, 6)
Controls("combobox6").ListIndex = 0
'-----####################--------------------
End With
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
If ComboBox3 = "" Or ComboBox1 = "" Or TextBox3 = "" Or TextBox3 = "jj/mm/aaaa" Or TextBox4 = "" Then
MsgBox ("Il manque une information obligatoire")
Else
If Sheets("TRACABILITE M.A.E").Range("a2") = "" Then
Sheets("TRACABILITE M.A.E").Range("a2") = TextBox1
Else
Sheets("TRACABILITE M.A.E").ListObjects(1).ListRows.Add
End If
'dlt fin de tableau a1048576 cellule bas max puis remonter derniere cellule pleine'
dlt = Sheets("TRACABILITE M.A.E").Range("a1048576").End(xlUp).Row
Sheets("TRACABILITE M.A.E").Range("a" & dlt) = ComboBox3
Sheets("TRACABILITE M.A.E").Range("b" & dlt) = ComboBox1
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("c" & dlt) = TextBox3.Value
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("e" & dlt) = TextBox4
Sheets("TRACABILITE M.A.E").Range("f" & dlt) = TextBox5
Sheets("TRACABILITE M.A.E").Range("g" & dlt) = ComboBox2
Unload UserForm1
End If
End Sub
Private Sub TextBox3_AfterUpdate()
On Error GoTo messagerreur
TextBox3 = Format(TextBox3, "short date")
Exit Sub
messagerreur:
MsgBox ("Le format n'est pas valide, le format de date est Jour/Mois/Année.")
TextBox3 = Empty
End Sub
Private Sub TextBox3_Enter()
If TextBox3 = "jj/mm/aaaa" Then
TextBox3 = ""
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox3 = "" Then
TextBox3 = "jj/mm/aaaa"
End If
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not ((KeyAscii > 46 And KeyAscii < 58)) Then
KeyAscii = 0
End If
End SubMerci, c'est beaucoup mieux. Il reste quelques détails. Je pense rajouter l'emplacement de la recherche nom et prénom dans le code suivant :
'nom&prénom en fonction du num lot'
Private Sub ComboBox4_Change()
ComboBox7.Clear
Call msAjr(Val(ComboBox4.Text))
For i = 0 To UBound(tbl)
ComboBox7.AddItem tbl(i, 4)
Next
End SubEn effet, lorsque je rajoute une ligne, il ne la trouve pas dans la recherche. Pourtant quand je rajoute une ligne, cela agrandit bien le tableau.
Salut
Tu veux dire :
Si tu fais une recherche sur la coté droite pour lots=1 par exemple .Ensuite sur la coté gauche (les contrôles de coté droite restent remplis) tu ajoutes une entrée avec lots=1 et tu veux là que la nouvelle entrée s’ajoute automatiquement sur la coté droite après qu’on tu clique sur "Ajouter" !
Non, la fonction d'ajout qui est à gauche fonctionne parfaitement.C'est pris en compte dans mon tableau.
Mais la fonction de modification qui est à droite n'est pas fonctionnelle à 100%.
Quand je fais des tests et que je rajoute des lignes à la main, il reconnait les noms et prénoms. Mais quand j'utilise la fonction d'ajout à gauche, les cellules "LOT" à droite sont reconnues mais pas les noms&prénoms liés aux lots. (Uniquement quand j'ajoute avec le module de gauche, les lignes rajoutées à la main sont reconnues)
Salut
regarde ça :
Dim Ws 'OU Dim Trsblt 'à déclarer en haut de module
Dim tbl
Sub msAjr(Vsrch)
Dim m As Integer
'--------#############--------
If ComboBox4.ListIndex = -1 Or ComboBox4.Text = "" Then Exit Sub
drlgn = Ws.Cells(Rows.Count, "A").End(xlUp).Row
n = Application.CountIf(Ws.Range("A2:A" & drlgn), Vsrch)
ReDim tbl(n - 1, 11)
For i = 2 To drlgn
If CStr(Ws.Cells(i, "A")) = CStr(Vsrch) Then
For col = 1 To 10 '10 = N² de derniere colonne contient les données
tbl(m, col - 1) = Ws.Cells(i, col)
tbl(m, 10) = i '9 + 1 = 10
Next
m = m + 1
End If
Next
'--------#############--------
End Sub
Private Sub CommandButton2_Click()
Dim no_ligne As Integer
If ComboBox4.Value = "" Or ComboBox4.ListIndex = -1 Then
MsgBox ("Veuillez renseigner votre numéro de lot ainsi que le nom et prénom du patient.")
Exit Sub
End If
If ComboBox7.Value = "" Or ComboBox7.ListIndex = -1 Then
MsgBox ("Veuillez renseigner votre numéro de lot ainsi que le nom et prénom du patient.")
Exit Sub
End If
no_ligne = tbl(ComboBox7.ListIndex, 10)
Ws.Cells(no_ligne, 2) = ComboBox5.Value
Ws.Cells(no_ligne, 3) = TextBox7.Value
Ws.Cells(no_ligne, 4) = TextBox8.Value
Ws.Cells(no_ligne, 6) = TextBox9.Value
Ws.Cells(no_ligne, 7) = ComboBox6.Value
End Sub
'recherche numero lot'
Private Sub UserForm_Initialize()
Dim tmps, m As Integer
m = 0
ReDim tmps(m)
'OU Set Trsblt = Sheets("TRACABILITE M.A.E")
Set Ws = Sheets("TRACABILITE M.A.E")
ComboBox4.Clear
drlgn = Ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = drlgn To 2 Step -1
n = Application.CountIf(Ws.Range("a" & i & ":a" & drlgn), Ws.Cells(i, 1))
If n = 1 Then
ReDim Preserve tmps(m)
tmps(m) = Val(Ws.Cells(i, 1)): m = m + 1
End If
Next
For b = 1 To 26
For j = 0 To m - 1
If tmps(j) = b Then ComboBox4.AddItem b: Exit For
Next
Next
TextBox3.Text = "jj/mm/aaaa"
End Sub
'nom&prénom en fonction du num lot'
Private Sub ComboBox4_Change()
ComboBox7.Clear
Call msAjr(Val(ComboBox4.Text))
For i = 0 To UBound(tbl)
ComboBox7.AddItem tbl(i, 4)
Next
End Sub
Private Sub ComboBox7_Change()
Dim ligne
If ComboBox7.ListIndex = -1 Then
Controls("Combobox5").Clear
Controls("textbox7") = ""
Controls("textbox8") = ""
Controls("textbox9") = ""
Controls("combobox6").Clear
Exit Sub
End If
With Ws
'-----####################--------------------
ligne = ComboBox7.ListIndex
Controls("Combobox5").AddItem tbl(ligne, 1)
Controls("Combobox5").ListIndex = 0
Controls("textbox7") = tbl(ligne, 2)
Controls("textbox8") = tbl(ligne, 3)
Controls("textbox9") = tbl(ligne, 5)
Controls("combobox6").AddItem tbl(ligne, 6)
Controls("combobox6").ListIndex = 0
'-----####################--------------------
End With
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
If ComboBox3 = "" Or ComboBox1 = "" Or TextBox3 = "" Or TextBox3 = "jj/mm/aaaa" Or TextBox4 = "" Then
MsgBox ("Il manque une information obligatoire")
Else
If Sheets("TRACABILITE M.A.E").Range("a2") = "" Then
Sheets("TRACABILITE M.A.E").Range("a2") = TextBox1
Else
Sheets("TRACABILITE M.A.E").ListObjects(1).ListRows.Add
End If
'dlt fin de tableau a1048576 cellule bas max puis remonter derniere cellule pleine'
dlt = Sheets("TRACABILITE M.A.E").Range("a1048576").End(xlUp).Row
Sheets("TRACABILITE M.A.E").Range("a" & dlt) = ComboBox3
Sheets("TRACABILITE M.A.E").Range("b" & dlt) = ComboBox1
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("c" & dlt) = TextBox3.Value
TextBox3 = Format(TextBox3, "mm/dd/yyyy")
Sheets("TRACABILITE M.A.E").Range("e" & dlt) = TextBox4
Sheets("TRACABILITE M.A.E").Range("f" & dlt) = TextBox5
Sheets("TRACABILITE M.A.E").Range("g" & dlt) = ComboBox2
Unload UserForm1
End If
End Sub
Private Sub TextBox3_AfterUpdate()
On Error GoTo messagerreur
TextBox3 = Format(TextBox3, "short date")
Exit Sub
messagerreur:
MsgBox ("Le format n'est pas valide, le format de date est Jour/Mois/Année.")
TextBox3 = Empty
End Sub
Private Sub TextBox3_Enter()
If TextBox3 = "jj/mm/aaaa" Then
TextBox3 = ""
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox3 = "" Then
TextBox3 = "jj/mm/aaaa"
End If
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not ((KeyAscii > 46 And KeyAscii < 58)) Then
KeyAscii = 0
End If
End SubBonjour AMIR, j'ai pu tester le code et tout fonctionne parfaitement. Encore merci
Il ne manque plus que le format des dates n'apparait pas en date et pas sous la bonne forme (10/04/2021) par exemple, et mes calculs avec DATEDIF ne peuvent pas être fait même si je convertis la date à la main en date courte.
Merci de ton aide précieuse
Salut
pour les contrôles de date tu peux suivre cette méthode : Format(TextBox, "mm/dd/yyyy"
par exemple Controls("textbox8") = tbl(ligne, 3) devient :
Controls("textbox8") = Format(tbl(ligne, 3), "mm/dd/yyyy")Ok merci, je vais apporter ces dernières corrections demain et le tout devrait être fonctionnel à 100%.
Encore merci pour ta patience et ton aide, je te tiens informer demain.
Bonjour,
1) Quand j'ajoute une donnée via l'userform sur le textbox3 la date est correcte mais il ne prend pas le format date courte (10/05/2021) ; il est en personnalisé. Par contre la date est bonne quand je clique sur date courte. J'ai pourtant précisé que je voulais date courte.
Private Sub TextBox3_AfterUpdate()
On Error GoTo messagerreur
TextBox3 = Format(TextBox3, "short date")
Exit Sub
messagerreur:
MsgBox ("Le format n'est pas valide, le format de date est Jour/Mois/Année.")
TextBox3 = Empty
End Sub2) Quand je fais ma recherche dans le userform, le textbox7 qui se pré-rempli a le format 10/05/2021.
3) Quand je force la modification dans le userform en retappant à la main le textbox7 et textbox8 j'ai bien 05/10/2021 qui s'affiche dans le tableau mais toujours en personnalisé et pour Excel c'est le 10/05/2021 10Mai2021 qui est pris en compte.
si ça se produit sur les feuilles Excel , essai de personnalisé les cellules concernées au format "date courte"
C'est ce que j'ai fait sur les colonnes mais l'action du userform écrase le format pour le mettre en personnalisée
Salut
ne laisse pas les cellules sous une forme personnalisées
Salut,
Oui c'est ce que j'ai fait. Mais quand je remplis l'userform et que je rajoute une ligne, mes cellules changent de format pour se mettre en personnalisée. Je voudrais que ca reste en date courte.
Salut
essaye comme ça : Cells(1, 1) = Format(TextBox3, "short date")
et pas :
TextBox3 = Format(TextBox3, "short date")
Cells(1, 1) = TextBox3Salut, ça ne fonctionne pas.
En fait, même quand j'écris une date à la main dans le tableau défini, il change le format dès que je quitte la cellule alors que celle ci est en date courte de base.
Quand je descends plus bas que mon tableau et que j'essaye cela fonctionne. Mais quand je rentre la donnée à la main dans ma cellule du tableau ça se convertit.
N'est ce pas un probleme de variable?
Merci