Problème UserForm
Résolu/Ferméjeanphilippe13 Messages postés 126 Date d'inscription vendredi 3 novembre 2006 Statut Membre Dernière intervention 17 juin 2023 - 17 juin 2023 à 19:02
- Problème UserForm
- Afficher userform vba a l'ouverture d'excel - Forum Programmation
- Afficher une feuille excel dans un userform vba - Forum Excel
- Vba date picker excel 365 userform 64 bit ✓ - Forum Excel
- Palette couleur vba userform - Forum VB / VBA
- Afficher une image dans un userform vba ✓ - Forum Excel
6 réponses
17 juin 2023 à 18:40
Il faut donc remplir le champs "Licence" ?
Merci pour votre aide vraiment !!!
11 juin 2023 à 09:25
Bonjour
Afin que les intervenants puissent vous aider efficacement, veuiller montrer votre code.
Merci
11 juin 2023 à 17:53
Bonjour à tous les deux
Un petit exemple
https://www.cjoint.com/c/MFlp0WuKzaB
Cdlmnt
11 juin 2023 à 18:55
Merci ccm81.
C'est déja plus clair ;-)
11 juin 2023 à 18:52
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 question13 juin 2023 à 17:51
Personne pour une soluce ?
Cordialement.
16 juin 2023 à 08:49
Bonjour,
Avoir le fichier en main m'aidera bien à vous aider.
Cordialement
Willzac
16 juin 2023 à 08:54
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.
16 juin 2023 à 14:10
Hello,
Poste plutôt ton fichier sur le site cjoint.com et donne ici le lien créé
16 juin 2023 à 21:27
16 juin 2023 à 21:34
Bonjour,
le fichier en question est disponible sur le lein :
https://www.cjoint.com/c/MFqtBtORILC
En vous remerciant.
Modifié le 17 juin 2023 à 12:30
Hello,
Pour les adhérents ton code est basé sur la colonne A de la feuille Données.
Il fonctionne bien si tu remplis le champ licence et il ne fonctionne pas si tu ne le remplis pas !
17 juin 2023 à 18:58
Hello,
Il faut donc remplir le champs "Licence" ?
Bah oui, sinon pour tester sur la colonne B (Nom) tu peux remplacer ton code par :
17 juin 2023 à 19:02
Merci à toi Bigoudii. Ca fonctionne de nouveau..
Bon weekend
Cordialement.
Jp