Problème UserForm
Résolujeanphilippe13 Messages postés 127 Statut Membre -
Bonjour à tous et toutes,
je me permets de vous faire ce message car j'aurais besoin d'aide au sujet d'un "userForm" que j'ai créer.
Lorsque je remplie mes champs et que je clique sur le bouton "Ajouter" , les informations s'écrasent sur la première ligne, ca ne passe pas sur la ligne suivante.
Merci pour votre aide.
6 réponses
Bonjour
Afin que les intervenants puissent vous aider efficacement, veuiller montrer votre code.
Merci
Bonjour et merci pour vos réponses.
@ Choubaka voici le code en question :
Function copy_from_form()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Base de données").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Base de données")
.Range("A" & LastRow).Value = TextBox1.Value
.Range("B" & LastRow).Value = TextBox2.Value
.Range("C" & LastRow).Value = TextBox3.Value
.Range("D" & LastRow).Value = TextBox4.Value
.Range("E" & LastRow).Value = TextBox5.Value
.Range("F" & LastRow).Value = TextBox6.Value
.Range("G" & LastRow).Value = TextBox7.Value
.Range("H" & LastRow).Value = TextBox8.Value
.Range("I" & LastRow).Value = TextBox9.Value
End With
End Function
Private Sub CommandButton1_Click()
Call copy_from_form
Call reset_all_controls
End Sub
Function search_from_form()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Base de données").Activate
Set rng1 = Sheets("Base de données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
TextBox1.Value = Sheets("Base de données").Range("A" & row_number).Value
TextBox2.Value = Sheets("Base de données").Range("B" & row_number).Value
TextBox3.Value = Sheets("Base de données").Range("C" & row_number).Value
TextBox4.Value = Sheets("Base de données").Range("D" & row_number).Value
TextBox5.Value = Sheets("Base de données").Range("E" & row_number).Value
TextBox6.Value = Sheets("Base de données").Range("F" & row_number).Value
TextBox7.Value = Sheets("Base de données").Range("G" & row_number).Value
TextBox8.Value = Sheets("Base de données").Range("H" & row_number).Value
TextBox9.Value = Sheets("Base de données").Range("I" & row_number).Value
Else
MsgBox str_search & "Not Found"
End If
End Function
Private Sub CommandButton2_Click()
Call search_from_form
End Sub
Function delete_from_form_with_confirmation()
Dim answer As Integer
answer = MsgBox("Delete This Row of Data", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Base de données").Activate
Set rng1 = Sheets("Base de données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Base de données").Rows(row_number).EntireRow.Delete
Else
End If
End Function
Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function
'Suppression dans la base de données
Function delete_from_form_without_confirmation()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Base de données").Activate
Set rng1 = Sheets("Base de données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Base de données").Rows(row_number).EntireRow.Delete
End If
End Function
Private Sub CommandButton3_Click()
Call delete_from_form_without_confirmation
End Sub
Private Sub CommandButton7_Click()
Call reset_all_controls
End Sub
Private Sub UserForm_Click()
End Sub
En vous remerciant.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionBonjour,
Avoir le fichier en main m'aidera bien à vous aider.
Cordialement
Willzac
Bonjour,
merci pour votre aide;
Voici le code en question car je ne vois d'icone pour pièce jointe.
'Fonction ajouter
Function copy_from_form()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Données").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Données")
.Range("A" & LastRow).Value = TextBox1.Value
.Range("B" & LastRow).Value = TextBox2.Value
.Range("C" & LastRow).Value = TextBox3.Value
.Range("D" & LastRow).Value = TextBox4.Value
.Range("E" & LastRow).Value = TextBox5.Value
.Range("F" & LastRow).Value = TextBox6.Value
.Range("G" & LastRow).Value = TextBox7.Value
.Range("H" & LastRow).Value = TextBox8.Value
.Range("I" & LastRow).Value = TextBox9.Value
End With
End Function
Private Sub CommandButton1_Click()
Call copy_from_form
End Sub
'Fonction Rechercher
Function search_from_form()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox2.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
TextBox1.Value = Sheets("Données").Range("A" & row_number).Value
TextBox2.Value = Sheets("Données").Range("B" & row_number).Value
TextBox3.Value = Sheets("Données").Range("C" & row_number).Value
TextBox4.Value = Sheets("Données").Range("D" & row_number).Value
TextBox5.Value = Sheets("Données").Range("E" & row_number).Value
TextBox6.Value = Sheets("Données").Range("F" & row_number).Value
TextBox7.Value = Sheets("Données").Range("G" & row_number).Value
TextBox8.Value = Sheets("Données").Range("H" & row_number).Value
TextBox9.Value = Sheets("Données").Range("I" & row_number).Value
Else
MsgBox str_search & "Not Found"
End If
End Function
Private Sub CommandButton2_Click()
Call search_from_form
End Sub
'Fonction supprimer
Function delete_from_form_with_confirmation()
Dim answer As Integer
answer = MsgBox("Delete This Row of Data", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Données").Rows(row_number).EntireRow.Delete
Else
End If
End Function
'Fonction Reinitialiser
Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function
Private Sub CommandButton7_Click()
Call reset_all_controls
End Sub
'Suppression dans la Données
Function delete_from_form_without_confirmation()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Données").Rows(row_number).EntireRow.Delete
End If
End Function
Private Sub CommandButton3_Click()
Call delete_from_form_without_confirmation
End Sub
'AJOUT MERE
Function copy_from_form_mere()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Mere").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Mere")
.Range("A" & LastRow).Value = TextBox12.Value
.Range("B" & LastRow).Value = TextBox14.Value
.Range("C" & LastRow).Value = TextBox16.Value
.Range("D" & LastRow).Value = TextBox20.Value
.Range("E" & LastRow).Value = TextBox18.Value
End With
End Function
Private Sub CommandButton5_Click()
Call copy_from_form_mere
End Sub
'AJOUT PERE
Function copy_from_form_pere()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Pere").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Pere")
.Range("A" & LastRow).Value = TextBox11.Value
.Range("B" & LastRow).Value = TextBox13.Value
.Range("C" & LastRow).Value = TextBox15.Value
.Range("D" & LastRow).Value = TextBox19.Value
.Range("E" & LastRow).Value = TextBox18.Value
.Range("I" & LastRow).Value = TextBox9.Value
End With
End Function
Private Sub CommandButton4_Click()
Call copy_from_form_pere
End Sub
'AJOUT PRELEVEMENT
Function copy_from_form_prelevement()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Règlement").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Règlement")
.Range("A" & LastRow).Value = TextBox12.Value
.Range("B" & LastRow).Value = TextBox14.Value
.Range("C" & LastRow).Value = TextBox16.Value
.Range("D" & LastRow).Value = TextBox20.Value
.Range("E" & LastRow).Value = TextBox18.Value
End With
End Function
Private Sub CommandButton6_Click()
Call copy_from_form_prelevement
End Sub
Cordialement.
Bonjour,
le fichier en question est disponible sur le lein :
https://www.cjoint.com/c/MFqtBtORILC
En vous remerciant.
Hello,
Il faut donc remplir le champs "Licence" ?
Bah oui, sinon pour tester sur la colonne B (Nom) tu peux remplacer ton code par :
Merci à toi Bigoudii. Ca fonctionne de nouveau..
Bon weekend
Cordialement.
Jp