Code à corriger

Résolu
mustalger Messages postés 5 Statut Membre -  
 paul -
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

8 réponses

  1. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour,
    Pouvez-vous préciser le problème... ?

    0
  2. mustalger Messages postés 5 Statut Membre
     
    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
    0
  3. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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)... !

    0
  4. mustalger Messages postés 5 Statut Membre
     
    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
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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 !

    0
  7. Zoul67 Messages postés 2001 Statut Membre 149
     
    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+
    0
  8. mustalger Messages postés 5 Statut Membre
     
    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
    0
    1. Zoul67 Messages postés 2001 Statut Membre 149
       
      Deux solutions :
      - essaie de modifier le 20 au début de ton code : xx = 20 ;
      - si ça ne marche pas, fais appel à ton ami.

      Si tu es fâché avec ce dernier, il te faudra lire tout le code et remplacer les suites de x par des mots plus parlants (ex remplacer xxx par derniere_ligne). Tu apprendras VBA du même coup.
      0
    2. paul
       
      Salut, je viens de tomber sur ce post, je serais curieux de savoir si le probleme a été résolu.
      0
  9. mustalger Messages postés 5 Statut Membre
     
    Bonsoir
    merci beaucoup pour le tout et bon courage.
    a+
    0