Code a corregir

Resuelto
Bonsoir,
por favor en excel vba limite en el número de registros, ¿cómo corregir eso?
gracias

Private Sub CommandButton_enreg_Click() If ComboBox_groupe.ListIndex = -1 Then xxxxxxxxxxxxxxxxxxxxxx = MsgBox("No ha definido un grupo...", 48, "Error") Exit Sub End If If TextBox_3 = "" And TextBox_4 = "" And TextBox_5 = "" Then xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Complete al menos uno de los siguientes campos :" & Chr(10) & Chr(10) & " - Nombre" & Chr(10) & " - Apellido" & Chr(10) & " - Empresa", 48, "Error") 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 respuestas

  1. Buenas noches
    muchas gracias por todo y buena suerte.
    hasta luego
    0
    1. Buenas noches
      gracias por todo, es realmente muy amable de su parte.
      El código me lo dio un amigo, a quien le pedí ayuda para construir una aplicación de gestión de correos. Aquí está un poco de la historia.
      y el código completo :
      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("Ingrese el nuevo nombre del campo """ & xxxxxxxxxxxx & """ :", "Modificar", 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("Ingrese el nuevo nombre del campo """ & xxxxxxxxxxxx & """ :", "Modificar", 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("Ingrese el nuevo nombre del campo """ & xxxxxxxxxxxx & """ :", "Modificar", 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 = " Contactos"
      If xxxxxx = 2 Then xxxxxxxxxxxxxx = " Contacto"
      If xxxxxx < vbQuestion Then
      Me.Caption = "Correos - " & xxxxxx - 1 & xxxxxxxxxxxxxx
      End If
      End Sub
      Private Sub xxxxxxxxxxx()
      xxxxxx = BD.Range("A1").End(xlDown).Row
      xxxxxxxxxxxxxx = " Contactos"
      If xxxxxx = 2 Then xxxxxxxxxxxxxx = " Contacto"
      If xxxxxx < vbLong ^ 3 Then
      If xxxxxxxxxxxxxxx >= 0 Then
      Me.Caption = "Contactos-Práctica - " & xxxxxxxxxxxxxxx + 1 & "/" & xxxxxx - 1 & xxxxxxxxxxxxxx
      Else
      Me.Caption = "Contactos-Práctica - " & 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 = "LÍNEA"
      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 datos está vacía.", 64, "Información")
      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 = "LÍNEA"
      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("No ha definido un grupo ...", 48, "Error")
      Exit Sub
      End If
      If TextBox_3 = "" And TextBox_4 = "" And TextBox_5 = "" Then
      xxxxxxxxxxxxxxxxxxxxxx = MsgBox("Complete al menos uno de los siguientes campos:" & Chr(10) & Chr(10) & " - Nombre" & Chr(10) & " - Apellido" & Chr(10) & " - Empresa", 48, "Error")
      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 = "LÍNEA" 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 = "LÍNEA" 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 = "LÍNEA" 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("Contacto seleccionado :" & Chr(10) & Chr(10) & xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx & Chr(10) & Chr(10) & "¿Está seguro de que desea eliminar este contacto de forma permanente?", 36, "Solicitud de confirmación") = 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. Dos soluciones:
        - intenta modificar el 20 al principio de tu código: xx = 20 ;
        - si eso no funciona, llama a tu amigo.

        Si estás enfadado con él, tendrás que leer todo el código y reemplazar las sucesiones de x por palabras más claras (por ejemplo, reemplazar xxx por ultima_línea). Aprenderás VBA de paso.
        0
      2. Hola, acabo de encontrar este post, me gustaría saber si el problema se ha resuelto.
        0
    2. Hola,

      Como hay diferentes números de x, creo que se trata de una técnica de ofuscación; cada cadena debe corresponder a algo específico descrito en otra parte del código (variables públicas,...).

      mustalger: ¿puedes proporcionar el código completo o indicar de dónde obtuviste el archivo/código correspondiente?

      ¡Hasta luego!
      0
      1. Hola,
        No han entendido nada.
        No es que no quiera, al contrario, es su código que no ha sido ... está truncado por xxxxxxxx.

        --
        Saludos.
        El Pingüino
        0
        1. Hola, encontré un código en internet, así que no conozco al autor de este código.
          Pensé que podría contar con ustedes, ¡qué pena..!

          Gracias por todo.
          0
          1. Hola,
            Gracias.
            ¿Por qué no contactar a la persona que creó este código...?
            Además, faltan todas las instrucciones que están reemplazadas por los (xxxxx), lo que no permite ver un límite de los registros (a 20)... !

            --
            Saludos.
            El Pingüino
            0
            1. Buenas noches,
              gracias por la respuesta
              el problema es que este código no es mío.
              en este código se limita el registro a 20 registros, lo que quiero es que alguien pueda liberarme de esto, es decir, eliminar esta condición
              gracias por todo.
              0
              1. Hola,
                ¿Puede precisar el problema...?

                --
                Saludos.
                El Pingüino
                0