Validacion para no ingresar datos en la misma linea vb

publicado el 24 de febrero11 años

Jovenes gusto saludarles de nuevo, ahora con la siguiente pregunta:

Ustedes me podrian hacer el favor de oritentarme ya que estoy haciendo un mini proyecto en excel con vb y tengo el siguiente inconveniente...

necesito ingresar por medio de un formulario datos de control de combustible de una flota de camiones, pero al momento de crear la programacion del formulario utilize los siguientes codigos...

Private Sub CommandButton2_Click()


Dim LastRow As Object


Set LastRow = Hoja8.Range("A1048576").End(xlUp)


LastRow.Offset(1, 0).Value = TextBox1.Text

LastRow.Offset(1, 1).Value = TextBox2.Text

LastRow.Offset(1, 2).Value = TextBox3.Text

LastRow.Offset(1, 3).Value = TextBox4.Text

LastRow.Offset(1, 4).Value = TextBox5.Text

LastRow.Offset(1, 5).Value = TextBox6.Text

LastRow.Offset(1, 6).Value = TextBox7.Text

LastRow.Offset(1, 7).Value = TextBox8.Text

LastRow.Offset(1, 8).Value = TextBox9.Text

LastRow.Offset(1, 9).Value = TextBox10.Text

LastRow.Offset(1, 10).Value = TextBox11.Text

LastRow.Offset(1, 11).Value = TextBox12.Text

LastRow.Offset(1, 12).Value = TextBox13.Text


MsgBox "Se ha escrito un registro en la Hoja8"


response = MsgBox("¿Desea añadir otro registro?", _

vbYesNo)


If response = vbYes Then

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

TextBox7.Text = ""

TextBox8.Text = ""

TextBox9.Text = ""

TextBox10.Text = ""

TextBox11.Text = ""

TextBox12.Text = ""

TextBox13.Text = ""

TextBox1.SetFocus


Else

Unload Me

End If

If response = vbNo Then

Workbooks("CONTROL DE KILOMETRAJE_3.XLSM").Close SaveChanges:=True

End If


End Sub[/CODE]

donde al momento de ingresar a veces en algunas lineas me ingresa el dato y en otras me lo ingresa sobre la linea anterior... osea sobre escribe en algunas veces sobre la fila anterior que ya se ha creado...

por otra.. quisiera que por cada ingreso me genere un numero de correlativo... para llevar un control.. el correlativo lo necesito asi:

NUMERO DE BOLETA:

CODIGO DE CAMION:

de ante mano muchas gracias por su apoyo...saludos..desde Guatemala

bye.

publicado el 24 de febrero11 años

Hola, recuerda siempre subir un archivo de ejemplo para poder ayudarte mejor, ahora por lo que veo el problema esta aquí:

Set LastRow = Hoja8.Range("A1048576").End(xlUp)[/CODE]

Cambiala por esta:

[CODE]Set LastRow = Hoja8.Range("A1048576").End(xlUp).offset(1,0)[/CODE]

Y lo otro depende de en que celdas estarían colocados, sube un ejemplo.

Salu2

publicado el 24 de febrero11 años

Autor

Ok ahorita intento. lo que pasa es que es algo grande y pues al parecer no me va a dejar .. ahorita intento permiteme..

saludos.

publicado el 24 de febrero11 años

Autor

sabes probe la formula y en las primeras 10 lineas no dio error pero ahora me da cada vez que ingreso un registro me deja una linea de por medio... se podria hacer que siga en la siguiente linea?

saludos

publicado el 24 de febrero11 años

Autor

oye, me sigue dando el problema pero me doy cuenta que es a veces cuando dejas alguna casilla en blanco y no todas estan llenas, y cuando grabas te vuelve a grabar en la misma linea .. el archivo es muy grande que puedo hacer ahi ?

saludos..y gracias

publicado el 24 de febrero11 años

Adjunta un archivo de ejemplo, solo formulario y la hoja donde se ingresan los datos nada mas, todo lo demás lo eliminas.

Salu2

publicado el 24 de febrero11 años

Autor

amigo aca te subo solo el formulario y los datos a ingresar... sabes a cada ingreso quisiera que me generara y guardara un correlativo por cada ingreso y por cada codigo de camion.. por ejemplo...

formulario1

cod. camion: 54-03

correlativo 00001

entonces algo asi: ingreso numero: 5403-00001

o algo que me identifique de que camion es el ingreso...

ya que van a ser aprox 15 formularios en este proyecto.. gracias y saludos...

CONTROL DE KILOMETRAJE3 - copia (2) - copia.zip

publicado el 24 de febrero11 años

Autor

:bump:

publicado el 24 de febrero11 años

Autor

:bump:

publicado el 24 de febrero11 años

Pues me acabo de fijar que pones en esta linea por ejemplo:



LastRow.Offset(1, 0).Value = TextBox1.Text

LastRow.Offset(1, 1).Value = TextBox2.Text

LastRow.Offset(1, 2).Value = TextBox3.Text

[/CODE]

y debería ser así

[CODE]
LastRow.Offset(0, 0).Value = TextBox1.Text
LastRow.Offset(0, 1).Value = TextBox2.Text
LastRow.Offset(0, 2).Value = TextBox3.Text
[/CODE]

Por eso te salta una linea de mas.

Te propongo que pruebes con este otro código haber si te parece mejor, es mas corto:

[CODE]Private Sub CommandButton2_Click()
Dim tex As Control
Dim LastRow As String
LastRow = Hoja8.Range("A" & Rows.Count).End(xlUp).Row + 1
x = 1
For Each tex In Me.Controls
If InStr(1, tex.Name, "TextBox") Then Cells(LastRow, x).Value = tex.Value: x = x + 1
Next
MsgBox "Se ha escrito un registro en la Hoja2"

If MsgBox("¿Desea añadir otro registro?", _
vbYesNo) = vbNo Then Workbooks("CONTROL DE KILOMETRAJE3.XLSM").Close SaveChanges:=True: Unload Me

For Each tex In Me.Controls
If InStr(1, tex.Name, "TextBox") Then tex.Value = ""
Next

End Sub[/CODE]

Y con lo otro el Cod. del camión lo ingresas manual y el correlativo obviamente es automático, el cod. del camion es el campo que dice ID Vehículo cierto??

publicado el 24 de febrero11 años

Autor

cierto, ya que quiero agregar un pequeño reporte de cada camion, pero eso creo que no lo puedo hacer... ahi si me quedo corto en reportes jejeje.. si tu tambien me puedes apoyoar te lo agradeceria..

ahorita pruebo los codigos y te cuento s

saludos...

publicado el 24 de febrero11 años

Prueba el adjunto el Numero de Ingreso lo coloca en la celda M

Salu2

CONTROL DE KILOMETRAJE3 - copia (2) - copia.zip

publicado el 25 de febrero11 años

Autor

Excelente, fijate que te queria molestar ese codigo que da de registro se podra mostrar en pantalla a la hora de terminar de ingresar el formulario?? osea que te de un mensaje donde te de el numero de registro que realizo??? pero que te lo de en pantalla.... mil gracias saludos.,...

publicado el 25 de febrero11 años

Modifica el código así:

Private Sub CommandButton2_Click()

Dim tex As Control

Dim LastRow As String

LastRow = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1

correlativo = Range("XFD1").Value + 1

x = 1

For Each tex In Me.Controls

If InStr(1, tex.Name, "TextBox") Then Cells(LastRow, x).Value = tex.Value: x = x + 1

Next

Cells(LastRow, x).Value = TextBox2 & "-" & Format(correlativo, "000000")

Range("XFD1") = correlativo

MsgBox "Se ha escrito un registro en la Hoja2 con el numero de ingreso" _

& Chr(13) & TextBox2 & "-" & Format(correlativo, "000000")


If MsgBox("¿Desea añadir otro registro?", _

vbYesNo) = vbNo Then Workbooks("CONTROL DE KILOMETRAJE3.XLSM").Close SaveChanges:=True: Unload Me


For Each tex In Me.Controls

If InStr(1, tex.Name, "TextBox") Then tex.Value = ""

Next


End Sub[/CODE]

Pruebas y comentas.

Salu2

publicado el 25 de febrero11 años

Autor

Sabes al final utilice este codigo

Private Sub CommandButton2_Click()


Dim LastRow As Object


Set LastRow = Hoja2.Range("A1048576").End(xlUp).Offset(0, 0)


LastRow.Offset(1, 0).Value = TextBox1.Text

LastRow.Offset(1, 1).Value = TextBox2.Text

LastRow.Offset(1, 2).Value = TextBox3.Text

LastRow.Offset(1, 3).Value = TextBox4.Text

LastRow.Offset(1, 4).Value = TextBox5.Text

LastRow.Offset(1, 5).Value = TextBox6.Text

LastRow.Offset(1, 6).Value = TextBox7.Text

LastRow.Offset(1, 7).Value = TextBox8.Text

LastRow.Offset(1, 8).Value = TextBox9.Text

LastRow.Offset(1, 9).Value = TextBox10.Text

LastRow.Offset(1, 10).Value = TextBox11.Text

LastRow.Offset(1, 11).Value = TextBox12.Text

LastRow.Offset(1, 12).Value = TextBox13.Text


MsgBox "SE HA AÑADIDO UN REGISTRO AL VEHICULO 54-02"


response = MsgBox("¿DESEA AÑADIR OTRO REGISTRO?", _

vbYesNo)


If response = vbYes Then

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

TextBox7.Text = ""

TextBox8.Text = ""

TextBox9.Text = ""

TextBox10.Text = ""

TextBox11.Text = ""

TextBox12.Text = ""

TextBox13.Text = ""

TextBox1.SetFocus


Else

Unload Me

End If

If response = vbNo Then

Workbooks("CONTROL DE KILOMETRAJE_3.XLSM").Close SaveChanges:=True

End If



End Sub[/CODE]

me puedes hacer el favor de integrarmelo a este

saludos

publicado el 26 de febrero11 años

Autor

excelente mil gracias por tu apoyo Riddle @[uSER=143023]Riddle[/uSER]

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

Domina Excel, de Cero a Experto

¿Atascado? Deja de buscar soluciones puntuales. Aprende a dominar Excel para siempre con nuestro curso online. Más de 115 lecciones y soporte directo.

Ver el Curso Completo

194 Archivos
99 Comentarios
30 Revisiones
Última descarga

Nuevo mapa de municipios españoles
- 2

Crear un loop para emitir recibos

Hola! como estás? ante todo muchas gracias por tu aporte.
Te comento, hice la prueba pero tengo dos cuestiones. La macro original normalmente guarda una copia del recibo emitido en una carpeta de la pc y tambien envía una copia por correo.

Ahora bien, la macro funciona porque los recibos se me han guardado en la carpeta de la pc, pero uno de los problemas que tengo es que ahora no los envía por correo. Por otro lado, faltaría hacer que la nueva macro vaya reemplazando el contenido de la celda P17 con el codigo del inmueble que está imprimiendo de la lista, ya que, de lo contrario, siempre se imprime el mismo recibo.
Agradezco mucho si me podés ayudar a solucionar esas dos cuestiones

Por Corvette, · publicado el viernes a las 21:071 día
Crear un loop para emitir recibos

Prueba y comenta
ALQUILERES L - para POL.xlsm

Por JSDJSD, · publicado el viernes a las 09:051 día
Corregir error en código VBA (valores de “A pagar” y “Saldo” no se copian correctamente)

Muchas gracias JSDJSD, por la respuesta y por tomarse el tiempo de colaborarme.
Con ello doy por cerrado el tema
Un cordial saludo,
Dorge

Por dorgelis, · publicado el jueves a las 20:322 días
Crear un loop para emitir recibos

Buenas tardes! Como están?
Les comento, tengo una planilla que utilizo para emitir recibos de pago de las propiedades de las que administro el alquiler en mi inmobiliaria. Actualmente la planilla funciona bien, pero cuando tengo que imprimir los recibos, tengo que ir haciéndolos de a uno y me resultaría más practico escribir una lista de las propiedades de las que ya estoy en condiciones de realizar los recibos y que la macro se vaya repitiendo hasta que haya emitido todos los recibos (ya que la macro es bastante lenta y tengo que esperar unos 10 segundos entre recibo y recibo y son como 120 los que tengo que hacer)
Actualmente el recibo se completa cambiando el valor de una celda (que es el que identifica a cada inmueble), por lo que entiendo que lo unico que tendría que hacer el loop, es imprimir el primer recibo, copiar de una lista el número de identificacion de la siguiente propiedad de la lista, copiarlo en la celda que completa el recibo, volver a ejecutar la macro para generar el siguiente recibo y así sucesivamente hasta finalizar toda la lista. Eventualmente estaría bueno que aparezca un aviso cuando ya haya finalizado de emitir todos los recibos.
Adjunto el archivo en donde dejé indicado donde pondría la lista de codigos de propiedad a emitir, el boton que ejecuta las macros y cual es la celda que la macro iría modificando para completar los recibos con los datos de cada uno de los inmuebles a imprimir
La hojas se desbloquean con la clave 4324 o con el boton rojo que hay en las mismas (cada vez que se ejecuta la macro se vuelve a bloquear)
Desde ya les agradezco la ayuda!
Anexo:
La macro individual actual es la siguiente (en la planilla se ejecuta con un boton amarillo que está en la hoja consultas).

Sub Imagen13_Haga_clic_en()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "4324"
With Range("H7:R34")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Activate
.Chart.Paste
.Chart.Export "C:\Users\Usuario\Google Drive\LOCACIONES\REC. PROPIETARIOS\" & Format(Range("q20"), "mmmYY") & " - " & Range("Q9") & " - " & Range("P17") & " - " & Range("K19") & ".JPG"
.Delete
End With
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ (desactivé esto para que no imprima en papel)
'IgnorePrintAreas:=False
Range("AH6").Select
Selection.Copy
Range("AH9").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("Y7:AI33").Select
Selection.Copy
Range("H7").Select
ActiveSheet.Paste
Range("a4").Select
ActiveSheet.Protect "4324"
ActiveWorkbook.Save
Dim Email As CDO.Message
Set Email = New CDO.Message
correo_origen = "nqn.negocios@gmail.com"
Clave_correo_origen = "wkfhaapcnjljbwju"
correo_destino = Range("ak27").Value
Asunto = Range("ak28")
Mensaje = Range("ak29")
'correo_copia = "envioacorreocopia@gmail.com"
'correo_copia_oculta = "enviocopiaoculta@gmail.com"
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = correo_destino
.From = correo_origen
.Subject = Asunto
.TextBody = Mensaje
.Configuration.Fields.Update

If (Trim(correo_copia) = "") Then
.CC = correo_copia
End If
.AddAttachment (Range("ak30").Value)

On Error Resume Next
.Send
End With
End Sub
Sub powerbuttonINQ()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "4324"
With Range("H7:R33")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Activate
.Chart.Paste
.Chart.Export "C:\Users\Usuario\Google Drive\LOCACIONES\REC. INQUILINOS\" & Format(Range("q20"), "mmmYY") & " - " & Range("Q9") & " - " & Range("P17") & " - " & Range("J17") & ".JPG"
.Delete
End With
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
'IgnorePrintAreas:=False
Range("AH6").Select
Selection.Copy
Range("AH9").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("Y7:AI33").Select
Selection.Copy
Range("H7").Select
ActiveSheet.Paste
Range("a4").Select
ActiveSheet.Protect "4324"
ActiveWorkbook.Save
Dim Email As CDO.Message
Set Email = New CDO.Message
correo_origen = "nqn.negocios@gmail.com"
Clave_correo_origen = "wkfhaapcnjljbwju"
correo_destino = Range("ak27").Value
Asunto = Range("ak28")
Mensaje = Range("ak29")
'correo_copia = "envioacorreocopia@gmail.com"
'correo_copia_oculta = "enviocopiaoculta@gmail.com"
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = correo_destino
.From = correo_origen
.Subject = Asunto
.TextBody = Mensaje
.Configuration.Fields.Update

If (Trim(correo_copia) = "") Then
.CC = correo_copia
End If
.AddAttachment (Range("ak30").Value)

On Error Resume Next
.Send
End With
End Sub

ALQUILERES L - para POL.xlsm

Por Corvette, · publicado el jueves a las 18:472 días
Corregir error en código VBA (valores de “A pagar” y “Saldo” no se copian correctamente)

Prueba y comenta
CODIGO DE CELDA NO TRASLADA EL VALOR DESEADO EN ARCHIVO AYUDA EXCEL.xlsm

Por JSDJSD, · publicado el jueves a las 17:472 días

No hay usuarios registrado para ver esta página.

Conéctate a Ayuda Excel

Validacion para no ingresar datos en la misma linea vb

Featured Replies

Archivado

Archivos

Nuevo mapa de municipios españoles

Agenda Calendario Vintage

Cómo conservar la función AHORA()

Agenda v01

Gráficos de aranceles con colores difusos

Estadísticas de descargas

Mensajes

Crear un loop para emitir recibos

Crear un loop para emitir recibos

Corregir error en código VBA (valores de “A pagar” y “Saldo” no se copian correctamente)

Crear un loop para emitir recibos

Corregir error en código VBA (valores de “A pagar” y “Saldo” no se copian correctamente)

Visualizado recientemente 0

Account

Navigation

Buscar

Configure browser push notifications

Chrome (Android)

Chrome (Desktop)

Safari (iOS 16.4+)

Safari (macOS)

Edge (Android)

Edge (Desktop)

Firefox (Android)

Firefox (Desktop)