Plantilla Lista telefonica

[JoaoM]

Amigos mis saludos a todos.

He leido varios temas (varias paginas) pero en concreto no encontre nada de lo que me pudiera ayudar, a eso vengo, a pedirles ayuda.

En una web vi y baje esta programacion para acomodarla a mis necesidades pero no crean que soy un crack o experto en esto de programacion, lo de principiante creo me queda grande aun.

Una lista de numeros de telefono


En todos los textbox OBLIGATORIAMENTE tengo que INTRODUCIRLE caracteres, si no le introduzco me obliga a hacerlo para poder seguir, eso está bien pero, quisiera que en el segundo CODIGO 2º TELF, y CODIGO 3º TELF no me obligára a introducir algun caracter porque ni todos tienen 2 o 3 numeros y solo uno, entonces resumiendo

Que CODIGO 2º TELF, y CODIGO 3º TELF no me obliguen a ointroducir caracter alguno, es decir, quedar en vacio y al presionar en boton Incertar no me obligue a introducir algun caracter.

Les dejo el codigo para sí algun amigo/a pueda darme esa ayuda que necesito.
--- -----------------
Modulo
=======================
Rem Codigo tomado de:
Rem http://www.erlandsendata.no/english/...badacexportado
Rem Usado y modificado a mis necesidades

Sub exportaraccess()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, n As Long
Dim nfila As String

If [a2] = Empty Then
MsgBox prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical, Title:="Campos vacios"
Exit Sub
End If

Set cn = New ADODB.Connection
cn.Open "provider=microsoft.jet.oledb.4.0; " & "data source=" & ThisWorkbook.Path & "\Combinar2.mdb;"
Set rs = New ADODB.Recordset
rs.Open "Datos", cn, adOpenKeyset, adLockOptimistic, adCmdTable
n = 2
Do While Range("a" & n) <> Empty
With rs
.AddNew
.Fields("Nombre") = Range("a" & n).Value
.Fields("Hubicacion") = Range("b" & n).Value
.Fields("Codigo") = Range("c" & n).Value
.Fields("Telf") = Range("d" & n).Value
.Fields("Codigo") = Range("e" & n).Value
.Fields("Telf") = Range("f" & n).Value
.Fields("Codigo") = Range("g" & n).Value
.Fields("Telf") = Range("h" & n).Value
.Fields("Observacion") = Range("i" & n).Value
End With
n = n + 1
Loop

With rs
.AddNew
.Fields("Nombre") = Range("a" & n).Value
.Fields("Hubicacion") = Range("b" & n).Value
.Fields("Codigo") = Range("c" & n).Value
.Fields("Telf") = Range("d" & n).Value
.Fields("Codigo") = Range("e" & n).Value
.Fields("Telf") = Range("f" & n).Value
.Fields("Codigo") = Range("g" & n).Value
.Fields("Telf") = Range("h" & n).Value
.Fields("Observacion") = Range("i" & n).Value
End With

Set rs = Nothing
cn.Close
Set cn = Nothing

MsgBox prompt:="Los datos fueron enviados correctamente", Buttons:=vbOKOnly, Title:="DATOS EXPORTADOS"

If [a3] = Empty Then
Range("a2", Selection.End(xlToRight)).ClearContents
Exit Sub
End If

nfila = Range("A65535").End(xlUp).Row
Range("a2:d" + nfila).ClearContents

End Sub

Sub formulario1()
Formulario.Show
End Sub
----------------------------------------------------------------
(doble-click en el formulario)
-- ----
Private Sub CommandButton1_Click()
Dim nombre As String, hubicacion As String, celda As String
nombre = Len(TextBox1)
hubicacion = Len(TextBox2)
codigo = Len(TextBox3)
telf = Len(TextBox4)
codigo = Len(TextBox5)
telf = Len(TextBox6)
codigo = Len(TextBox7)
telf = Len(TextBox8)
observacion = Len(TextBox10)

'Aqui reviso que todos los campos esten llenos, como se puede ver, solo tengo hasta el textbox4 que 3 y 4 son CODIGO TELF
If TextBox1 = Empty Or TextBox2 = Empty Or TextBox3 = Empty Or TextBox4 = Empty Then
MsgBox prompt:="No deje ningun campo vacio", Buttons:=vbOKOnly, Title:="Campo vacio"
Exit Sub
End If

'El campo de nombre no debe tener mas de 50 caracteres, ya que en el
'access, dicho campo tiene ese limite
If nombre > 50 Then
MsgBox prompt:="El campo NOMBRE, puede contener como maximo 50 caracteres", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox1 = Empty
Exit Sub
End If

'El campo de hubicacion no debe tener mas de 20 caracteres, ya que en el
'access, dicho campo tiene ese limite
If hubicacion > 20 Then
MsgBox prompt:="El campo HUBICACION, puede contener como maximo 20 caracteres", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox2 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox3) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de CODIGO", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox3 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox4) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de TELF", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox4 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox5) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de CODIGO", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox5 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox6) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de 2º TELF", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox6 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox7) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de CODIGO", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox7 = Empty
Exit Sub
End If

'Este campo solo puede ser numerico, ya que en el access es de ese tipo
If Not IsNumeric(TextBox8) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de 3º TELF", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox8 = Empty
Exit Sub
End If

If [a2] = Empty Then
[a2].Select
GoTo ingresar:
End If
[a1].End(xlDown).Offset(1, 0).Select

ingresar:
celda = ActiveCell.Row
Range("a" + celda) = TextBox1
Range("b" + celda) = TextBox2
Range("c" + celda) = TextBox3
Range("d" + celda) = TextBox4
Range("e" + celda) = TextBox5
Range("f" + celda) = TextBox6
Range("g" + celda) = TextBox7
Range("h" + celda) = TextBox8
Range("i" + celda) = TextBox10
'El siguiente comentario, no hace parte de este codigo, era de un TextBox que se referia a edad, ya no existe
'En el access, el campo edad, no tiene decimales, por eso lo redondeo
'sin decimales
'Range("d" + celda) = Val(Round(TextBox3, 0))

TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
TextBox7 = Empty
TextBox8 = Empty
TextBox10 = Empty
TextBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
Call exportaraccess
End Sub

Private Sub CommandButton3_Click()
If [a2] <> Empty Then
MsgBox prompt:="Ud. no a exportado todos los datos", Buttons:=vbOKOnly + vbCritical, Title:="DATOS EN EXCEL"
End If
Unload Formulario
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Por favor, para salir use el boton correspondiente", vbInformation, "BOTON ANULADO"
End If
End Sub
---------------------------
el BOTON Exportar a ACCES lo voy a eliminar y lo que le corresponda porque no me interesa para el fin que quiero la plantilla

[DIEFRA]

'Aqui reviso que todos los campos esten llenos, como se puede ver, solo tengo hasta el textbox4 que 3 y 4 son CODIGO TELF
If TextBox1 = Empty Or TextBox2 = Empty Or TextBox3 = Empty Or TextBox4 = Empty Then
MsgBox prompt:="No deje ningun campo vacio", Buttons:=vbOKOnly, Title:="Campo vacio"
Exit Sub
End If

Si te entendi, solo tienes que borrar la condicion de los texbox 3 y 4, así:

'Aqui reviso que todos los campos esten llenos, como se puede ver, solo tengo hasta el textbox4 que 3 y 4 son CODIGO TELF
If TextBox1 = Empty Or TextBox2 = Empty Then
MsgBox prompt:="No deje ningun campo vacio", Buttons:=vbOKOnly, Title:="Campo vacio"
Exit Sub
End If

[JoaoM]

NO, en ese punto todo está como antes y tiene que estar, hasta el txtbox4 que es lo que me interesa, porque los textbox 5,6,7,8 son codigo y numero para telefonos secundarios (extras) y se agregan cuando los hay, es decir que si tu tienes 2 numeros de telefono, ya el segundo va el codigo en el textbox 5 y el numero en el 6. Si no hay numeros extras, entonces siempre me pediria en que los textbox 5,6,7,8 no pueden quedar vacios y eso no me daba la talla. Un numero siempre lo integras, para eso es la lista, lo que no sabes es si hay dos o 3 numeros pero el primer (textbox3 y 4) si OBLIGATORIAMENTE TIENES QUE INTRODUCIR EL NUMERO

Lo que hice fue eliminar el codigo

TODO este codigo referente a los textbox 5,6,7,8

'Este campo solo puede ser numerico
If Not IsNumeric(TextBox7) Then
MsgBox prompt:="Debe ingresar un valor numerico, en el campo de CODIGO", Buttons:=vbOKOnly, Title:="VALOR NULO"
TextBox7 = Empty
Exit Sub
End If

y colocar este a los textbox 5,6,7 y 8

Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Solo puede ingresar numeros", vbOKOnly + vbInformation, "AVISO"
End If
End Sub

anda de pinga
Pruebalo si quieres ver. Ya solo me falta eliminar el codigo referente a exportar a acces y su boton, vere si me sale bien para la lista telefonica.

No lo he echo antes porque tengo tiempo limitado para estas cosas pero me gusta

[JoaoM]

Lo anterior ya está listo solo que pensando mejor vi que al querer eliminar o editar alguna linea, solo podria hacerlo directamente desde las celdas, y eso lo quiero evitar y hacerlo desde el formulario, pues la cuestion es esta.

Ahora se trata que quise agregarle algo mas, ademas quiero hacer esto de forma que SOLO del formulario se pueda Incertar, eliminar o editar.
Pues al proyecto le agregue dos COMBOBOX y dos BOTONES mas, ELIMINAR, EDITAR.
Lo que les pido es una colaboración para el codigo para estos dos botones y COMBOBOXs, como dije antes, soy muy pero muy novato o principiante en esto de programacion


Aparece el formulario con datos porque los coloque manualmente para ejemplificar lo que necesito con los botones y ComboBoxes ELIMINAR Y EDITAR, selecionando el número, aparecen todos los datos de ese número en el formulario

1º- Quisiera que los 2 combobox se vaian llenando SOLO con el primer número (TELEFONO) conforme se van incertando datos
para eliminar un número (linea con los datos completa)
2º- Selecionar un número en el combobox de eliminar y, ese número haga que se llenen los TextBox con los datos correspondientes a ese número
3º- Presionar el boton ELIMINAR y se elimine la LINEA COMPLETA con sus datos correspondiente a ese número

El mismo procedimiento para el comboBox EDITAR, Seleciono un número en el ComboBox de EDITAR, al selecionar ese número se llenan los TextBox, edito y presiono el boton EDITAR. Aqui se incertan los datos editados en la linea correspondiente al número selecionado, presionando el boton EDITAR

No se si me hice entender, espero que si y que tambien exista alguna alma caritativa que me de su mano en este proyecto, LISTA TELEFONICA.

Les agrego acá el codigo que fuy reduciendo, quitandole el que hacia referencia a ACESS porque el codigo estaba echo para otra finalidad y fuy modificandolo poco a poco hasta llegar a esto.

MODULO

Rem Codigo tomado de:
Rem -http://www.erlandsendata.no/english/index.php?d=envbadacexportado
Rem que ya en nada se parece al que era cuando lo baje
Rem Usado y modificado por By Jot@ (Bombo)

Sub exportaraccess()

With rs
.AddNew
.Fields("Nombre") = Range("a" & n).Value
.Fields("Hubicacion") = Range("b" & n).Value
.Fields("Codigo") = Range("c" & n).Value
.Fields("Telf") = Range("d" & n).Value
.Fields("Codigo") = Range("e" & n).Value
.Fields("Telf") = Range("f" & n).Value
.Fields("Codigo") = Range("g" & n).Value
.Fields("Telf") = Range("h" & n).Value
.Fields("Observacion") = Range("i" & n).Value
End With

Set rs = Nothing
cn.Close
Set cn = Nothing

Sub formulario1()
Formulario.Show
End Sub

rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr rrrrrrrrrrrrr
GENERAL

Private Sub CommandButton1_Click()
Dim nombre As String, hubicacion As String, celda As String
nombre = Len(TextBox1) 'por lo de la cantidad de caracteres
hubicacion = Len(TextBox2) 'por lo de la cantidad de caracteres


'Aqui reviso que estos campos no este vazios
If TextBox1 = Empty Or TextBox2 = Empty Or TextBox3 = Empty Or TextBox4 = Empty Then
MsgBox prompt:=" Los primeros campos" & vbCrLf & " - Nombre" & vbCrLf & " - Direccion" & vbCrLf & " - ID y" & vbCrLf & " - TELEFONO" & vbCrLf & " no pueden estar vacios, Acepte para continuar", Buttons:=vbInformation + vbOKOnly, Title:="Campo vacio"
Exit Sub
End If

'El campo de nombre no debe tener mas de 30 caracteres
If nombre > 30 Then
MsgBox prompt:="El campo NOMBRE, puede contener como maximo 30 caracteres", Buttons:=vbInformation + vbOKOnly, Title:="VALOR NULO"
TextBox1 = Empty
Exit Sub
End If

'El campo de hubicacion no debe tener mas de 50 caracteres
If hubicacion > 50 Then
MsgBox prompt:="El campo HUBICACION, puede contener como maximo 50 caracteres", Buttons:=vbInformation + vbOKOnly, Title:="VALOR NULO"
TextBox2 = Empty
Exit Sub
End If

'El campo de hubicacion no debe tener mas de 150 caracteres
If observacion > 150 Then
MsgBox prompt:="El campo OBSERVACION, puede contener como maximo 150 caracteres", Buttons:=vbInformation + vbOKOnly, Title:="VALOR NULO"
TextBox2 = Empty
Exit Sub
End If

'Este campo solo puede ser numérico
If Not IsNumeric(TextBox3) Then
MsgBox prompt:="Debe ingresar SOLO valor numérico, en el campo ID", Buttons:=vbInformation + vbOKOnly, Title:="CARACTER NULO"
TextBox3 = Empty
Exit Sub
End If

'Este campo solo puede ser numérico
If Not IsNumeric(TextBox4) Then
MsgBox prompt:="Debe ingresar SOLO valor numérico, en el campo de TELFONO", Buttons:=vbInformation + vbOKOnly, Title:="CARACTER NULO"
TextBox4 = Empty
Exit Sub
End If

If [a2] = Empty Then
[a2].Select
GoTo ingresar:
End If
[a1].End(xlDown).Offset(1, 0).Select

ingresar:
celda = ActiveCell.Row
Range("a" + celda) = TextBox1
Range("b" + celda) = TextBox2
Range("c" + celda) = Val(Round(TextBox3, 0)) 'Range("c" + celda) = TextBox3
Range("d" + celda) = Val(Round(TextBox4, 0)) 'Range("d" + celda) = TextBox4
Range("e" + celda) = TextBox5
Range("f" + celda) = TextBox6
Range("g" + celda) = TextBox7
Range("h" + celda) = TextBox8
Range("i" + celda) = TextBox10
'La siguiente linea de comentario es de los TextBox para solo transmitir números enteros sin decimales
'Range("c" + celda) = Val(Round(TextBox3, 0))

TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
TextBox7 = Empty
TextBox8 = Empty
TextBox10 = Empty
TextBox1.SetFocus
End Sub

Private Sub CommandButton3_Click()
Unload Formulario
End Sub

Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Debe ingresar SOLO valor numerico, en el campo 2º ID", vbOKOnly + vbInformation, Title:="CARACTER NULO"
End If
End Sub

Private Sub TextBox6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Debe ingresar SOLO valor numerico, en el campo 2º TELF", vbOKOnly + vbInformation, Title:="CARACTER NULO"
End If
End Sub

Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Debe ingresar SOLO valor numerico, en el campo 3º ID", vbOKOnly + vbInformation, Title:="CARACTER NULO"
End If
End Sub

Private Sub TextBox8_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Debe ingresar SOLO valor numerico, en el campo 3º TELF", vbOKOnly + vbInformation, Title:="CARACTER NULO"
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Por favor, para salir use el boton correspondiente", vbInformation, "BOTON ANULADO"
End If
End Sub

rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr rrrrrrrrrrrrrrr

Las propiedades del TextBox 3, 5 y 7 estan para solamente aceptar 4 caracteres numéricos y los 4,6,8 estan para aceptar 7 nada mas, así como los TextBox 1 (NOMBRE) está para 30 caractares y el 2 (HUBICACION) está para 50. esto lo hice en propiedades porque con el codigo, uno escribe y escribe y solamente cuando vá a incertar es que dice que solo acepota X carateres y en las propiedades, llegando a los 30 no escribe mas.

En Office 2010, en el 2007 es lo mismo
Si alguien quier crear esto en su EXCCEL, ahí tiene todo el codigo mas el formulario para su diseño.
Solo no está el codigo de los ComboBox y BOTONES ELIMINAR Y EDITAR, que es presisamente lo que estoy pidiendo

Gracias amigos