[XL-2007] Ajout que si le tout est renseignés et sans doublons

[apt]

Bonsoir à tous,

Je voulais améliorer ce code qui teste si tous les TextBox d'un UserForm sont renseignés avant l'ajout dans la feuille.

Ainsi que d'éviter de saisir des doublons.

Je pensais au TextBox_Change, mais il faut le faire pour au moins 10 TextBox.

Alors y a-t-il une autre solution avec moins de code pour le réaliser ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 Option Explicit
Dim myCon()
 
Private Sub CommandButton2_Click()
    Dim R&, i&, N&
    '-- Si une textbox est vide, on la comptabilise
    For R = 0 To 5
        If Me.Controls(myCon(R)).Text = "" Then N = N + 1
    Next
    '-- Un cherche s'il y a doublon dans la colonne B
    For i = 2 To 50000
        If Feuil1.Cells(i, 2).Value = Val(TextBox2) Then
            MsgBox " >>>>>: Doublon, le code (" & Val(TextBox2) & ") est déja présent sur la feuille pour le nom  : " & Feuil1.Cells(i, 3).Text, 16, "Doublon du code"
            Exit Sub
        Else
        End If
    Next i
    '-- S'il y a au moins un textbox vide on s'arrête
    If N <> 0 Then MsgBox "Ajout échoué": GoTo 1
 
    '-- Autres traitements
    ' ....
    '---
 
1 End Sub
 
Private Sub CommandButton4_Click()
    Unload UserForm1
End Sub
 
Private Sub UserForm_Activate()
    myCon = Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6")
    H_A
End Sub
Private Sub H_A()
    Dim RR As Integer, Endrow As Integer
    Dim R As Long
    ComboBox1.Clear
    With Sheets("Feuil1")
        Endrow = .Range("A" & .Rows.Count).End(xlUp).Row
        For RR = 2 To Endrow
            ComboBox1.AddItem .Cells(RR, 1).Value
        Next RR
    End With
    For R = 0 To 5
        Me.Controls(myCon(R)) = ""
    Next
 
    ComboBox1.Value = ""
    CommandButton1.Enabled = True
    CommandButton3.Enabled = False
    TextBox1.Value = Endrow
    TextBox2.SetFocus
End Sub

[corona]

Bonsoir,
Une des solutions serait d'intégrer la vérification des valeurs dans une boucle en incrémentant le control TextBox
Un exemple qui suppose que le TextBox1 est une donnée à vérifier dans la colonne 1, TextBox2 en colonne 2, etc ...

Code :

1
2
3
4
5
6
7
 For Ind = 1 To 3     ' 3 TextBox 
  For r = 1 To nbrLignes  
   If Worksheets("Feuil1").Cells(r, Ind) = Me.Controls("Textbox" & Ind) Then
    MsgBox "Doublon"
   End If
  Next
 Next

Tu pourrais aussi utiliser la méthode Find dès que la donnée est validée dans le TextBox

[casefayere]

Bonsoir,

je t'avais préparé un code dans ce gout là (non testé)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CommandButton1_Click()
Dim R As Integer, plage As Range, derlg As Integer, Verif As Range
For R = 1 To 5
  If Me.Controls("myCon" & R) = "" Then MsgBox "il manque une valeur au textbox " & R: Exit Sub
Next R
derlg = Feuil1.Range("b" & Feuil1.Rows.Count).End(xlUp).Row
Set plage = Feuil1.Range("B1:b" & derlg)
Set Verif = plage.Find(TextBox2)
If Not Verif Is Nothing Then
  MsgBox " >>>>>: Doublon, le code (" & Val(TextBox2) & ") est déja présent sur la feuille pour le nom  : " & Verif.Address & "=>" & Verif.Value & " Doublon du code"
  Exit Sub
End If
End Sub

en tenant compte des remarques de Philippe, tu devrais pouvoir concocter quelque chose

[apt]

Bonsoir corona, casefeyere

Ca marche bien le contrôle des doublons dans la colonne B.

J'ai pensé remplacer la boucle de vérification des TextBox vides, par un module de classe.

Seulement j'ai lu qu'il ne gère pas l'événement Exit.

Une alternative pour cela ?

Merci.

[apt]

Re,

Une alternative pour remplacer l'événement Exit dans un module de classe, la gestion du focus :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'---- dans un module de classe nommé Classe1
Option Explicit
 
Public Event GetFocus()
Public Event LostFocus(ByVal Txtbx As String)
Public nomObjActif As String
 
Public Sub cibleFocus(USF As MSForms.UserForm)
With USF
        If TypeName(.ActiveControl) = "TextBox" Then
            nomObjActif = .ActiveControl.Name
            On Error GoTo errorHandler
            Do
                DoEvents
                If .ActiveControl.Name <> nomObjActif Then
                    If TypeName(.ActiveControl) = "TextBox" Then
                        RaiseEvent LostFocus(nomObjActif)
                        nomObjActif = .ActiveControl.Name
                        RaiseEvent GetFocus
                    End If
                End If
            Loop
            End If
End With
 
errorHandler:
Exit Sub
End Sub

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
'---  dans l'UserForm  ---
Option Explicit
Private WithEvents USF As Classe1
 
Private Sub UserForm_Activate()
    Set USF = New Classe1
 
    TextBox1.SetFocus
    Me.Controls(Me.ActiveControl.Name). _
        Object.BackColor = RGB(200, 200, 200)
 
    USF.cibleFocus Me
End Sub
 
Private Sub USF_GetFocus()
    Me.Controls(Me.ActiveControl.Name). _
        Object.BackColor = RGB(200, 200, 200)
End Sub
 
Private Sub USF_LostFocus(ByVal Txtbx As String)
    Me.Controls(Txtbx).BackColor = RGB(255, 255, 255)
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set USF = Nothing
End Sub

Source :
http://www.mrexcel.com/board2/viewto...er=asc&start=0

Mais à vrai dire, je n'ai rien compris dedans

Une explication et adaptation possible ?

Merci.