Re : Supprimer ligne complète dans USERFORM (collection jb)
Bonsoir Eric S et le forum
Bravo et merci c’est exactement ce que je recherchais .Pour répondre à ta question oui la ligne doit rester vierge car comme je te l’ai mis plus haut , la feuille qui reçoit le formulaire ou la correction à des liaisons.
Je viens de placer ton usf dans mon dossier et je l’ai adapté pour qu’il couvre les cellules A1 à J20 .
Un petit bug entre les codes sur la feuille de ton code et mon usf au niveau de :. Range("liste").End(xlDown).Offset(1, 0) = Target.Value
Titre du bug
(erreur d’exécution ‘1004’
Erreur définie par l’application ou par l’objet)
Voici les codes :
Ton code dans la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
If IsError(Application.Match(Target.Value, Range("liste"), 0)) Then
Range("liste").End(xlDown).Offset(1, 0) = Target.Value
Range("liste").Sort Key1:=Range("liste")(1)
End If
End If
End Sub
Le code usf
Private Sub ComboBox1_Change()
'Récupération du choix :
Me.TextBox1 = Me.ComboBox1.Value
End Sub
Private Sub UserForm3_Initialize()
Me.ComboBox1.ListIndex = 0 "positionne sur le premier élément
End Sub
Private Sub age_Change()
End Sub
Private Sub CommandButton1_Click()
CONVERTION1.Show
End Sub
Private Sub CommandButton2_Click()
UserForm1.Show
End Sub
e Sub CommandButton3_Click()
F_SupListe.Show
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range("profil")
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Me.profil.List = MonDico.items
End Sub
Private Sub b_validation_Click()
'--- Positionnement dans la base
[A65000].End(xlUp).Offset(2, 0).Select
'--- Transfert Formulaire dans BD
ActiveCell.Value = Application.Proper(Me.SousMotif)
ActiveCell.Offset(0, 1).Value = (Me.age)
ActiveCell.Offset(0, 2).Value = TITRE
ActiveCell.Offset(0, 3).Value = Me.nom
ActiveCell.Offset(0, 4).Value = Environ("username")
ActiveCell.Offset(0, 5).Value = (TextBox1)
ActiveCell.Offset(0, 6).Value = Now
ActiveCell.Offset(0, 7).Value = (Me.age2)
ActiveCell.Offset(0, 8).Value = (GEMRCN)
ActiveCell.Offset(0, 15).Value = Prenom2
ActiveCell.Offset(0, 17).Value = Prenom3
ActiveCell.Offset(0, 20).Value = (FAMILLEPRODUIT)
End Sub
Private Sub b_fin_Click()
Unload Me
End Sub
Private Sub profil_Change()
'LISTE DEROULANTE
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("motif").Count
If Range("profil")(i) = Me.profil Then
temp = Range("motif")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
Me.Motif.List = MonDico.items
Me.Motif.ListIndex = 0
End Sub
Private Sub Motif_Change()
'LISTE DEROULANTE
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("SousMotif").Count
If Range("Motif")(i) = Me.Motif Then
temp = Range("SousMotif")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
Me.SousMotif.List = MonDico.items
Me.SousMotif.ListIndex = 0
End Sub
Merci encore pour ton dévouement car au départ mes explications n’étaient pas très claires et je m’en excuse.
cordialement
