Ver Mensaje Individual
  #1 (permalink)  
Antiguo 30/07/2010, 15:50
JoaoM
 
Fecha de Ingreso: agosto-2007
Mensajes: 1.945
Antigüedad: 17 años, 4 meses
Puntos: 39
Plantilla Lista telefonica

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
__________________
Las contraseñas son como la ropa interior: Nunca dejarlas donde la gente pueda verlas
http://i64.tinypic.com/rho40i.jpg