Code à corriger Résolu/Fermé

Question

Bonsoir,
svp en excel vba limite dans  le nombre d'enregistrement, comment corriger cela.
merci

Private Sub CommandButton_enreg_Click()
If ComboBox_groupe.ListIndex = -1 Then
xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Vous n'avez pas défini de groupe ...", 48, "Erreur")
Exit Sub
End If
If TextBox_3 = "" And TextBox_4 = "" And TextBox_5 = "" Then
xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Complétez au minimum l'un des champs suivants :" & Chr(10) & Chr(10) & " - Nom" & Chr(10) & " - Prénom" & Chr(10) & " - Entreprise", 48, "Erreur")
Exit Sub
End If
xxxxxxxxxxxxxxxxxxx = Label_ligne.Caption
If IsNumeric(xxxxxxxxxxxxxxxxxxxxxxxxxxxxx) Then xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = Val(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx)
If Not IsNumeric(xxxxxxxxxxxxxxxxxxxxxxxxxxxxx) And BD.Range("A1").End(xlDown).Row > xx And BD.Range("A1").End(xlDown).Row < 65000 Then
UserForm_essai.Show
Exit Sub
End If
If xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "LIGNE" Then
xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Range("A1").End(xlDown).Row + 1
If xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = vbDouble ^ 2 - vbLong Then
CommandButon_enreg_Click
Exit Sub
ElseIf xxxxxxxxxxxxxxxxxxxxxxxxxxxxx > vbDouble ^ 2 - vbLong Then
xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = 2
End If
End If
BD.Cells(xxxxxxxxxxxxxxxxxxx, 1) = ComboBox_groupe.Value
For i = xx / 10 To xx + 8
If Mid(Controls("TextBox_" & i).Value, 1, 1) = "0" Or Mid(Controls("TextBox_" & i).Value, 1, 1) = "+" Then
BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxx, i) = "'" & Controls("TextBox_" & i).Value
Else
BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxx, i) = Controls("TextBox_" & i).Value
End If
Next
If Label_ligne.Caption = "LIGNE" Then
BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 29) = Date
xxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxx - 2
Label_rechercher_Click
ListBox_resultats.SetFocus
Else
BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, xx * 2 - 10) = Date
xxxxxxxxxxxxxxxxxx = ListBox_resultats.ListIndex
Label_rechercher_Click
ListBox_resultats.SetFocus
End If

Le Pingou · Answer

Bonjour,
Pouvez-vous préciser le problème... ?

mustalger · Answer

Bonsoir,
merci pour la réponse
le problème c'est que ce code n'est pas de moi.
dans ce code il limite les enregistrements  à 20  enregistrement, moi ce que je veux que quelqu'un puisse me libérer de ça c-à-dire enlever cette condition
merci. pour le tout

Le Pingou · Answer

Bonjour,
Merci. 
Pourquoi ne pas contacter la personne qui a créé ce code... ?
En plus il manque toutes les instructions qui sont remplacées par les (xxxxx) ce qui ne permet pas de constater une limite des enregistrements (à 20)... !

mustalger · Answer

Bonjour c'est un code que j'ai trouvé sur le net donc je ne connais pas l'auteur de ce code.
je me sus dit que je pourrais compter sur vous, dommage..!

merci pour le tout

Le Pingou · Answer

Bonjour,
Vous n'avez rien compris.
Ce n'est pas que je ne veux pas, au contraire c'est votre code qui n'en est pas eu ... est tronqué par des  xxxxxxxxx !

Zoul67 · Answer

Bonjour,

Comme il y a des nombres de x différents, je pense qu'il s'agit d'une technique d'obfuscation ; chaque chaîne doit correspondre à quelque chose de précis décrit par ailleurs dans le code (variables publiques,...).

mustalger : peux-tu donner le code complet ou indiquer où tu as récupéré le fichier/code correspondant ?

A+

mustalger · Answer

Bonsoir merci pour le tout c'est vraiment très gentil de votre part. le code il m'a été donnée par un ami, a qui j'ai demander de m'aider pour construire une application de gestion courriers. voilà un peu l'histoire. et le code complet : Option Compare Text Private Sub UserForm_Initialize() xx = 20 xxxxxxxx xxxxxxxxx TextBox_rech_nom.SetFocus xxxxxxxxxx Label14.Caption = BD.Range("Z1") & " :" Label12.Caption = BD.Range("AA1") & " :" Label11.Caption = BD.Range("AB1") & " :" xxx = BD.Range("A1").End(xlDown).Row End Sub Private Sub Label14_Click() xxxxxxxxxxxx = BD.Range("Z1") xxxxxxxxxxxxx = InputBox("Entrez le nouveau nom du champ """ & xxxxxxxxxxxx & """ :", "Modifier", xxxxxxxxxxxx) If xxxxxxxxxxxxx <> "" Then BD.Range("Z1") = xxxxxxxxxxxxx Label14.Caption = xxxxxxxxxxxxx & " :" End If End Sub Private Sub Label12_Click() xxxxxxxxxxxx = BD.Range("AA1") xxxxxxxxxxxxx = InputBox("Entrez le nouveau nom du champ """ & xxxxxxxxxxxx & """ :", "Modifier", xxxxxxxxxxxx) If xxxxxxxxxxxxx <> "" Then BD.Range("AA1") = xxxxxxxxxxxxx Label12.Caption = xxxxxxxxxxxxx & " :" End If End Sub Private Sub Label11_Click() xxxxxxxxxxxx = BD.Range("AB1") xxxxxxxxxxxxx = InputBox("Entrez le nouveau nom du champ """ & xxxxxxxxxxxx & """ :", "Modifier", xxxxxxxxxxxx) If xxxxxxxxxxxxx <> "" Then BD.Range("AB1") = xxxxxxxxxxxxx Label11.Caption = xxxxxxxxxxxxx & " :" End If End Sub Private Sub ComboBox_rech_groupe_Change() TextBox_rech_nom.SetFocus Label_rechercher_Click End Sub Private Sub TextBox_rech_nom_Change() Label_rechercher_Click End Sub Private Sub TextBox_rech_prenom_Change() Label_rechercher_Click End Sub Private Sub TextBox_rech_entreprise_Change() Label_rechercher_Click End Sub Private Sub TextBox_rech_poste_Change() Label_rechercher_Click End Sub Private Sub TextBox_rech_email_Change() Label_rechercher_Click End Sub Private Sub xxxxxxxxxx() xxxxxx = BD.Range("A1").End(xlDown).Row xxxxxxxxxxxxxx = " Contacts" If xxxxxx = 2 Then xxxxxxxxxxxxxx = " Contact" If xxxxxx < vbQuestion Then Me.Caption = "Courriers - " & xxxxxx - 1 & xxxxxxxxxxxxxx End If End Sub Private Sub xxxxxxxxxxx() xxxxxx = BD.Range("A1").End(xlDown).Row xxxxxxxxxxxxxx = " Contacts" If xxxxxx = 2 Then xxxxxxxxxxxxxx = " Contact" If xxxxxx < vbLong ^ 3 Then If xxxxxxxxxxxxxxx >= 0 Then Me.Caption = "Contacts-Pratique - " & xxxxxxxxxxxxxxx + 1 & "/" & xxxxxx - 1 & xxxxxxxxxxxxxx Else Me.Caption = "Contacts-Pratique - " & xxxxxx - 1 & xxxxxxxxxxxxxx End If End If End Sub Private Sub xxxxxxxxx() xxx = BD_DONNEES.Range("A1").End(xlDown).Row If xxx > BD_DONNEES.Range("A2" & vbNull).Row Then xxx = 0 ComboBox_rech_groupe.Clear ComboBox_groupe.Clear For i = xx / 10 To xxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD_DONNEES.Cells(i, 1) ComboBox_rech_groupe.AddItem xxxxxxxxxxxxxxxxxxxxxxxxxxxxx ComboBox_groupe.AddItem xxxxxxxxxxxxxxxxxxxxxxxxxxxxx Next End Sub Private Sub xxxxxxxxxxxxxxxxx() ComboBox_rech_groupe.ListIndex = -1 TextBox_rech_nom = "" TextBox_rech_prenom = "" TextBox_rech_entreprise = "" TextBox_rech_poste = "" ListBox_resultats.List() = Array() xxxxxxxxxxxxxxx = Empty Erase xxxxxxxxxxxxxxxxxxxx Label_exporter.Visible = False Label_ligne.Caption = "LIGNE" End Sub Private Sub xxxxxxxxxxxxxxxx() ComboBox_groupe.ListIndex = -1 Label_date_creation.Caption = " -" Label_date_modif.Caption = " -" For i = xx / 10 To xx + 8 Controls("TextBox_" & i).Value = "" Next CommandButton_suppr.Enabled = False End Sub Private Sub Label_rechercher_Click() xxxxxxxxxxxxxxxx Label_exporter.Visible = False If ComboBox_rech_groupe.ListIndex = -1 Then xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = ComboBox_rech_groupe.Value End If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_rech_nom xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_rech_prenom xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_rech_entreprise xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_rech_poste xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_rech_email xxxx = BD.Range("A1").End(xlDown).Row If xxxx > vbExclamation Then xxxxxxxxxxxxxxxxxxxxxx = MsgBox("La base de données est vide.", 64, "Information") Exit Sub End If Dim xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx() ReDim xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxx - 2, xx - 14) ReDim xxxxxxxxxxxxxxxxxxxx(xxxx - 2) xxxxxxxxxxxxxxx = -1 For xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = 2 To xxxx If xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 1) End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 3) End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 4) End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 5) End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 7) End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Then xxxxxxxxxxxxxxxxxxxxxxxxxxxx = "" Else xxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 22) End If If xxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" And _ xxxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" And _ xxxxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" And _ xxxxxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" And _ xxxxxxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" And _ xxxxxxxxxxxxxxxxxxxxxxxxxxxx Like "*" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & "*" Then xxxxxxxxxxxxxxx = xxxxxxxxxxxxxxx + 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 0) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 1) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 1) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 3) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 2) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 4) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 3) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 5) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 4) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 7) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 5) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 22) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 6) = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 20) xxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End If Next ListBox_resultats.ColumnCount = 7 ListBox_resultats.ColumnWidths = "87;97;95;97;95;120" If xxxxxxxxxxxxxxx > -1 Then Label_exporter.Visible = True If xxxxxxxxxxxxxxx = xxxx - 2 Then ListBox_resultats.List() = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Else Dim xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx() ReDim xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(xxxxxxxxxxxxxxx, 6) For i = 0 To xxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 0) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 0) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 1) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 1) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 2) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 2) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 3) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 3) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 4) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 4) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 5) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 5) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 6) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(i, 6) Next ListBox_resultats.List() = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End If If Not IsEmpty(xxxxxxxxxxxxxxxxxx) Then If xxxxxxxxxxxxxxxxxx = "MAX" Then ListBox_resultats.ListIndex = xxxxxxxxxxxxxxx Else If xxxxxxxxxxxxxxx >= xxxxxxxxxxxxxxxxxx Then ListBox_resultats.ListIndex = xxxxxxxxxxxxxxxxxx Else ListBox_resultats_Change End If End If xxxxxxxxxxxxxxxxxx = Empty Else ListBox_resultats_Change End If Else ListBox_resultats.List() = Array() Label_ligne.Caption = "LIGNE" End If xxxxxxxxxxx End Sub Private Sub ListBox_resultats_Change() If ListBox_resultats.ListIndex = -1 Or IsEmpty(xxxxxxxxxxxxxxx) Then xxxxxxxxxxxxxxxx Exit Sub End If If xxxxxxxxxxxxxxx = -1 Then xxxxxxxxxxxxxxxx Exit Sub End If CommandButton_suppr.Enabled = True xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxx(ListBox_resultats.ListIndex) Label_ligne.Caption = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ComboBox_groupe.ListIndex = -1 xxx = BD_DONNEES.Range("A1").End(xlDown).Row If xxx > vbYesNoCancel ^ 3 Then xxx = 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 1) For i = xx / 10 To xxx If BD_DONNEES.Cells(i, 1) = xxxxxxxxxxxxxxxxxxxxxxxxxxxxx Then ComboBox_groupe.ListIndex = i - 2 End If Next For i = 2 To 28 Controls("TextBox_" & i).Value = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, i) Next Label_date_creation.Caption = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 29) If BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 30) <> "" Then Label_date_modif.Caption = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 30) Else Label_date_modif.Caption = " -" End If End Sub Private Sub Label_modif_groupes_Click() UserForm_groupes.Show xxxxxxxxx End Sub Private Sub CommandButton_fermer_Click() Unload Me End Sub Private Sub CommandButton_nouveau_Click() xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxx End Sub Private Sub CommandButton_enreg_Click() If ComboBox_groupe.ListIndex = -1 Then xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Vous n'avez pas défini de groupe ...", 48, "Erreur") Exit Sub End If If TextBox_3 = "" And TextBox_4 = "" And TextBox_5 = "" Then xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Complétez au minimum l'un des champs suivants :" & Chr(10) & Chr(10) & " - Nom" & Chr(10) & " - Prénom" & Chr(10) & " - Entreprise", 48, "Erreur") Exit Sub End If xxxxxxxxxxxxxxxxxxx = Label_ligne.Caption 'rajout 19 If IsNumeric(xxxxxxxxxxxxxxxxxxx) Then xxxxxxxxxxxxxxxxxxx = Val(xxxxxxxxxxxxxxxxxxxxxxxx) If Not IsNumeric(xxxxxxxxxxxxxxxxxxx) And BD.Range("A1").End(xlDown).Row > xx And BD.Range("A1").End(xlDown).Row < 65000 Then UserForm_essai.Show Exit Sub End If If xxxxxxxxxxxxxxxxxxx = "LIGNE" Then xxxxxxxxxxxxxxxxxxx = BD.Range("A1").End(xlDown).Row + 1 If xxxxxxxxxxxxxxxxxxx = vbDouble ^ 2 - vbLong Then CommandButon_enreg_Click Exit Sub ElseIf xxxxxxxxxxxxxxxxxxx > vbDouble ^ 2 - vbLong Then xxxxxxxxxxxxxxxxxxx = 2 End If End If BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 1) = ComboBox_groupe.Value For i = xx / 10 To xx + 8 If Mid(Controls("TextBox_" & i).Value, 1, 1) = "0" Or Mid(Controls("TextBox_" & i).Value, 1, 1) = "+" Then BD.Cells(xxxxxxxxxxxxxxxxxxx, i) = "'" & Controls("TextBox_" & i).Value Else BD.Cells(xxxxxxxxxxxxxxxxxxx, i) = Controls("TextBox_" & i).Value End If Next If Label_ligne.Caption = "LIGNE" Then BD.Cells(xxxxxxxxxxxxxxxxxxx, 29) = Date xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxx - 2 Label_rechercher_Click ListBox_resultats.SetFocus Else BD.Cells(xxxxxxxxxxxxxxxxxxx, xx * 2 - 10) = Date xxxxxxxxxxxxxxxxxx = ListBox_resultats.ListIndex Label_rechercher_Click ListBox_resultats.SetFocus End If Me.BackColor = &HE4FFEE xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = Now + TimeValue("00:00:02") Application.OnTime xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" End Sub Private Sub CommandButton_suppr_Click() xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = Label_ligne.Caption If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = "LIGNE" Then Exit Sub xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 3) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 4) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = BD.Cells(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 5) If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx <> "" And xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx <> "" Then xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & " " & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Else xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End If If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx <> "" Then If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx <> "" Then xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & ", " & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Else xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End If Else xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End If BD.Cells(vbInteger & 3, 3).Delete xlUp If MsgBox("Contact sélectionné :" & Chr(10) & Chr(10) & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & Chr(10) & Chr(10) & "Etes-vous sûr de vouloir supprimer définitivement ce contact ?", 36, "Demande de confirmation") = vbYes Then BD.Range(xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & ":" & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx).Delete Label_rechercher_Click ListBox_resultats.SetFocus End If End Sub Private Sub Label_exporter_Click() UserForm_exporter.Show End Sub Private Sub xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx(ByVal xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx) Application.DisplayAlerts = False Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx .Display End With Set OutMail = Nothing Set OutApp = Nothing Application.DisplayAlerts = True End Sub Private Sub CommandButon_enreg_Click() 'UserForm_essai.Show End Sub Private Sub TextBox_22_Change() xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = TextBox_22 If xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Like "*@*" And xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Like "*.*" Then Label_outlook.Visible = True TextBox_22.Width = 336 Else Label_outlook.Visible = False TextBox_22.Width = 336 End If End Sub Private Sub Label_outlook_Click() xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx End Sub Private Sub xxxxxxxx() xxx = BD.Range("A1").End(xlDown).Row If xxx < vbString * 3 Then With BD .Range("A2:AD" & xxx).Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("C2") _ , Order2:=xlAscending, Key3:=.Range("D2"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ xlSortNormal End With End If End Sub Private Sub Label_copy_Click() UserForm_copy.Show End Sub

mustalger · Answer

Bonsoir 
merci beaucoup pour le tout et bon courage.
a+

Code à corriger

8 réponses

Discussions similaires