Code a corregir

Resuelto
mustalger Mensajes publicados 5 Estado Miembro -  
 paul -
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. Le Pingou Mensajes publicados 12275 Fecha de registro   Estado Colaborador Última intervención   1 477
     
    Hola,
    ¿Puede precisar el problema...?

    --
    Saludos.
    El Pingüino
    0
  2. mustalger Mensajes publicados 5 Estado Miembro
     
    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
  3. Le Pingou Mensajes publicados 12275 Fecha de registro   Estado Colaborador Última intervención   1 477
     
    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
  4. mustalger Mensajes publicados 5 Estado Miembro
     
    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
  5. Le Pingou Mensajes publicados 12275 Fecha de registro   Estado Colaborador Última intervención   1 477
     
    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
  6. Zoul67 Mensajes publicados 2001 Estado Miembro 149
     
    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
  7. mustalger Mensajes publicados 5 Estado Miembro
     
    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. Zoul67 Mensajes publicados 2001 Estado Miembro 149
       
      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. paul
       
      Hola, acabo de encontrar este post, me gustaría saber si el problema se ha resuelto.
      0
  8. mustalger Mensajes publicados 5 Estado Miembro
     
    Buenas noches
    muchas gracias por todo y buena suerte.
    hasta luego
    0