Formulaire saisie de données - Écrase toujours la ligne malgré le code
Bonjour,
J'ai monté 4 formulaires de base me permettant de regrouper des données dans un tableau que je pourrais par la suite questionner. Sur 4 formulaires, 2 fonctionne très bien et 2 ne fonctionnent pas. Pourtant ils sont tous faits exactement de la même façon ?
J'ai monté le formulaire et la base de données pour qu'à chaque fois que j'ajoute un nouvel enregistrement au formulaire, il y ai une nouvelle ligne de créer dans la base de données. Mon problème est que j'arrive à entrer une ligne dans ma ba se données, une deuxième aussi. Par contre aussitôt que j'en ajoute une troisième, celle-ci écrase la deuxième...
Quelqu'un peux me donner un coup de main à régler le problème s.v.p.?
Merci à l'avance pour votre aides!
'*****************************************************************
'Procédure permettant d'ajouter un nouvel enregistrement
'*****************************************************************
Private Sub btnAjout_Click()
Sheets("Inspection").Activate
Range("A2").Select
Selection.End(xlDown).Select 'On se positionne sur la dernière ligne non vide
Selection.Offset(1, 0).Select 'On se décalle d'une ligne vers le bas
ActiveCell = txtDate.Value
ActiveCell.Offset(0, 1).Value = txtBT
ActiveCell.Offset(0, 2).Value = txtInfoProduit
ActiveCell.Offset(0, 3).Value = txtInfoBT
ActiveCell.Offset(0, 4).Value = txtLot
ActiveCell.Offset(0, 5).Value = cboCodagelisible1
ActiveCell.Offset(0, 6).Value = cboCodagelisible2
ActiveCell.Offset(0, 7).Value = cboCodagelisible3
ActiveCell.Offset(0, 8).Value = cboCodagebouteilleBT1
ActiveCell.Offset(0, 9).Value = cboCodagebouteilleBT2
ActiveCell.Offset(0, 10).Value = cboCodagebouteilleBT3
ActiveCell.Offset(0, 11).Value = cboCodagecaisselisible1
ActiveCell.Offset(0, 12).Value = cboCodagecaisselisible2
ActiveCell.Offset(0, 13).Value = cboCodagecaisselisible3
ActiveCell.Offset(0, 14).Value = cboCodagecaisseBT1
ActiveCell.Offset(0, 15).Value = cboCodagecaisseBT2
ActiveCell.Offset(0, 16).Value = cboCodagecaisseBT3
ActiveCell.Offset(0, 17).Value = cboBouchon1
ActiveCell.Offset(0, 18).Value = cboBouchon2
ActiveCell.Offset(0, 19).Value = cboBouchon3
ActiveCell.Offset(0, 20).Value = cboSiropbouteille1
ActiveCell.Offset(0, 21).Value = cboSiropbouteille2
ActiveCell.Offset(0, 22).Value = cboSiropbouteille3
ActiveCell.Offset(0, 23).Value = cboSiropfilets1
ActiveCell.Offset(0, 24).Value = cboSiropfilets2
ActiveCell.Offset(0, 25).Value = cboSiropfilets3
ActiveCell.Offset(0, 26).Value = cboTemperature1
ActiveCell.Offset(0, 27).Value = cboTemperature2
ActiveCell.Offset(0, 28).Value = cboTemperature3
ActiveCell.Offset(0, 29).Value = cboBPF
ActiveCell.Offset(0, 30).Value = txtDetail6
ActiveCell.Offset(0, 31).Value = cboEnvironnement
ActiveCell.Offset(0, 32).Value = txtDetail7
ActiveCell.Offset(0, 33).Value = cboFormulaireBienRempli
ActiveCell.Offset(0, 34).Value = txtDetail8
ActiveCell.Offset(0, 35).Value = txtCommentaire
ActiveCell.Offset(0, 36).Value = txtInitiale
MsgBox "L'inspection a bien été ajouté à la base de données", vbOKOnly + vbInformation, "CONFIRMATION"
End Sub
Bonjour,
Un souci, la méthode pour ajouter une ligne au tableau avant d'y inscrire les données.
Pour une autre feuille, il suffit d'adapter le nom du tableau au besoin (2 endroits)
Essai ainsi ...
Private Sub btnAjout_Click()
Dim X As Long
Sheets("Inspection").Activate
Range("TEmbouteilleuse").Select ' <<< adapter le nom du tableau au besoin
Selection.ListObject.ListRows.Add AlwaysInsert:=True
X = Range("TEmbouteilleuse").Rows.Count + 2 ' <<< adapter le nom du tableau au besoin
Cells(X, "A") = txtDate.Value
Cells(X, "A").Offset(0, 1).Value = txtBT
Cells(X, "A").Offset(0, 2).Value = txtInfoProduit
Cells(X, "A").Offset(0, 3).Value = txtInfoBT
Cells(X, "A").Offset(0, 4).Value = txtLot
Cells(X, "A").Offset(0, 5).Value = cboCodagelisible1
Cells(X, "A").Offset(0, 6).Value = cboCodagelisible2
Cells(X, "A").Offset(0, 7).Value = cboCodagelisible3
Cells(X, "A").Offset(0, 8).Value = cboCodagebouteilleBT1
Cells(X, "A").Offset(0, 9).Value = cboCodagebouteilleBT2
Cells(X, "A").Offset(0, 10).Value = cboCodagebouteilleBT3
Cells(X, "A").Offset(0, 11).Value = cboCodagecaisselisible1
Cells(X, "A").Offset(0, 12).Value = cboCodagecaisselisible2
Cells(X, "A").Offset(0, 13).Value = cboCodagecaisselisible3
Cells(X, "A").Offset(0, 14).Value = cboCodagecaisseBT1
Cells(X, "A").Offset(0, 15).Value = cboCodagecaisseBT2
Cells(X, "A").Offset(0, 16).Value = cboCodagecaisseBT3
Cells(X, "A").Offset(0, 17).Value = cboBouchon1
Cells(X, "A").Offset(0, 18).Value = cboBouchon2
Cells(X, "A").Offset(0, 19).Value = cboBouchon3
Cells(X, "A").Offset(0, 20).Value = cboSiropbouteille1
Cells(X, "A").Offset(0, 21).Value = cboSiropbouteille2
Cells(X, "A").Offset(0, 22).Value = cboSiropbouteille3
Cells(X, "A").Offset(0, 23).Value = cboSiropfilets1
Cells(X, "A").Offset(0, 24).Value = cboSiropfilets2
Cells(X, "A").Offset(0, 25).Value = cboSiropfilets3
Cells(X, "A").Offset(0, 26).Value = cboTemperature1
Cells(X, "A").Offset(0, 27).Value = cboTemperature2
Cells(X, "A").Offset(0, 28).Value = cboTemperature3
Cells(X, "A").Offset(0, 29).Value = cboBPF
Cells(X, "A").Offset(0, 30).Value = txtDetail6
Cells(X, "A").Offset(0, 31).Value = cboEnvironnement
Cells(X, "A").Offset(0, 32).Value = txtDetail7
Cells(X, "A").Offset(0, 33).Value = cboFormulaireBienRempli
Cells(X, "A").Offset(0, 34).Value = txtDetail8
Cells(X, "A").Offset(0, 35).Value = txtCommentaire
Cells(X, "A").Offset(0, 36).Value = txtInitiale
MsgBox "L'inspection a bien été ajouté à la base de données", vbOKOnly + vbInformation, "CONFIRMATION"
End Sub
ric
Merci beaucoup !! Ça fonctionne maintenant avec votre aides !
ric
Bonjour a tous a propos j'ai aussi le même problème pouvez vous m'aider svp
j'ai crée un formulaire mais a chaque que j'essai d'ajouter il écrase la précédente.
Sub ajouter_entre()
'
'ajouter_entree macro
'
'
Sheets("Formulaire").Range("B3:H3").Select
Selection.Copy
Sheets("ENTR_STK").Select
Range("B2").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Formulaire").Select
Range("c6").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("e6").Select
Selection.ClearContents
Range("g6").Select
Selection.ClearContents
Range("c11").Select
Selection.ClearContents
Range("e11").Select
Selection.ClearContents
Range("c15").Select
Selection.ClearContents
Range("e15").Select
Selection.ClearContents
Range("d20").Select
End Sub
Bonjour lyes5317,
Il serait plus respectueux d'ouvrir ta propre demande.
ric
Salut, désoler je suis nouveau je ne sais pas comment faire
je m'en excuse