Code a corregir
Resuelto
mustalger
Mensajes publicados
5
Estado
Miembro
-
paul -
paul -
Bonsoir,
por favor en excel vba limite en el número de registros, ¿cómo corregir eso?
gracias
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
Enlaces relacionados:
- código para salto de línea en VBA Excel
- écrire una potencia matemática con el código VBA de Excel
- Protección de celdas excepto para el código VBA
- Aumentar el tamaño de un código de barras / de una fuente
- ¿Abrir un documento de Excel utilizando un código QR u otra solución?
- Código de control de código de barras EAN14
8 respuestas
-
Hola,
¿Puede precisar el problema...?
--
Saludos.
El Pingüino -
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. -
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 -
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. -
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 -
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! -
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-
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. -
-
-
Buenas noches
muchas gracias por todo y buena suerte.
hasta luego