saban
02-08-2006, 02:23 AM
Ok I have managed to put records into all sheets with this code:
Option Explicit
Dim st As Integer
Private Sub UserForm_Activate()
'Activamos la primera celda
'susceptible de contener datos
'Range("a65536").End(xlUp).Offset(1, 0).Activate
ActiveSheet.Range("a3").Activate
'Buscamos la primera fila sin
'datos en la columna nombre
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Sub cmdAceptar_Click()
'Antes de ingresar los datos
'comprobamos que sean correctos
ValidarCampos
End Sub
Private Sub cmdTerminar_Click()
'Descargamos el formulario
Unload frmTomarDatos
End Sub
Private Sub txtEntidad_Change()
'Al escribir los 4 d?gitos de la entidad
'pasamos al siguiente campo
If Len(txtEntidad.Text) = 4 Then
txtOficina.SetFocus
End If
End Sub
Private Sub txtOficina_Change()
'Al escribir los 4 d?gitos de la oficina
'pasamos al siguiente campo
If Len(txtOficina.Text) = 4 Then
txtControl.SetFocus
End If
End Sub
Private Sub txtControl_Change()
'Al escribir los 2 d?gitos de control
'pasamos al siguiente campo
If Len(txtControl.Text) = Date Then
txtCuenta.SetFocus
End If
End Sub
Private Sub txtCuenta_Change()
'Al escribir los 10 d?gitos del n?mero
'de cuenta situamos el foco sobre el
'bot?n cmdAceptar
If Len(txtCuenta.Text) = 10 Then
cmdAceptar.SetFocus
End If
End Sub
Private Sub ValidarCampos()
Dim r As Long
Dim c As Long
Dim i As Long
Dim Error As String
Dim ws As Worksheet
Dim ValorMensaje As Long
'Turn off Screen refresh
Application.ScreenUpdating = False
'Use Cells(Row, Column) for range adddress
r = ActiveCell.Row
c = ActiveCell.Column
For i = 1 To Sheets.Count
'Use ws as worksheet(sheet number)
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
Set ws = Worksheets(i)
'r = ws.Range("a65536").End(xlUp).Row
' ws.Range("A1").Value = frmTomarDatos.txtNombre.Value
Error = "napaka v datumu"
If Len(frmTomarDatos.txtNombre.Text) = 0 Then
ValorMensaje = MsgBox("El campo Nombre est? vac?o", vbOKOnly, Error)
frmTomarDatos.txtNombre.SetFocus
' Was error so exit sub to correct error
Exit Sub
Else
If Len(frmTomarDatos.txtApellidos.Text) = 0 Then
ValorMensaje = MsgBox("vnesi podatke", vbOKOnly, Error)
frmTomarDatos.txtApellidos.SetFocus
' Was error so exit sub to correct error
Exit Sub
Else
' st is used elewhere?
st = frmTomarDatos.txtNombre.Text * 1
With ws.Cells(r, c)
.Value = txtNombre * 1
.Offset(0, 1).Value = frmTomarDatos.txtApellidos.Value
.Offset(0, 2).Value = frmTomarDatos.txtEntidad.Value * 1
.Offset(0, 3).Value = frmTomarDatos.txtOficina.Value
.Offset(0, 4).Value = frmTomarDatos.txtControl.Value
.Offset(0, 5).Value = frmTomarDatos.txtCuenta.Value
End With
'**************************************************
'Don't know what this does!
' ActiveCell.Offset(1, 0).Activate
' BorrarFormulario
'**************************************************
End If
End If
Next i
'Turn Screen refresh on
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
txtNombre.Value = Null
' txtNombre.Value = Null
txtApellidos.Value = Null
txtEntidad.Value = Null
txtOficina.Value = Null
txtControl.Value = Null
txtCuenta.Value = Null
End Sub
Private Sub BorrarFormulario()
'Ponemos la cadena vac?a
'a todos los campos
txtNombre.Text = ""
txtApellidos.Text = ""
txtEntidad.Text = ""
txtOficina.Text = ""
txtControl.Text = ""
txtCuenta.Text = ""
'Situamos el foco en el campo Nombre
txtNombre.SetFocus
End Sub
But the problem is I would like to put records in free rows not to overwrite the existing ones
ex: in sheet1 I add record to free row(lets say in 6 row) it works fine but when I look into other sheets it adds data but it overwrites sixth row and i dont wanna do that I would like to put this data in free row (not in the same row as in sheet1).
And when this is done I would like to delete data added in sheets where cells in G column says "Zaseden" and is higlighted with red
thnx for any advice
Option Explicit
Dim st As Integer
Private Sub UserForm_Activate()
'Activamos la primera celda
'susceptible de contener datos
'Range("a65536").End(xlUp).Offset(1, 0).Activate
ActiveSheet.Range("a3").Activate
'Buscamos la primera fila sin
'datos en la columna nombre
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Sub cmdAceptar_Click()
'Antes de ingresar los datos
'comprobamos que sean correctos
ValidarCampos
End Sub
Private Sub cmdTerminar_Click()
'Descargamos el formulario
Unload frmTomarDatos
End Sub
Private Sub txtEntidad_Change()
'Al escribir los 4 d?gitos de la entidad
'pasamos al siguiente campo
If Len(txtEntidad.Text) = 4 Then
txtOficina.SetFocus
End If
End Sub
Private Sub txtOficina_Change()
'Al escribir los 4 d?gitos de la oficina
'pasamos al siguiente campo
If Len(txtOficina.Text) = 4 Then
txtControl.SetFocus
End If
End Sub
Private Sub txtControl_Change()
'Al escribir los 2 d?gitos de control
'pasamos al siguiente campo
If Len(txtControl.Text) = Date Then
txtCuenta.SetFocus
End If
End Sub
Private Sub txtCuenta_Change()
'Al escribir los 10 d?gitos del n?mero
'de cuenta situamos el foco sobre el
'bot?n cmdAceptar
If Len(txtCuenta.Text) = 10 Then
cmdAceptar.SetFocus
End If
End Sub
Private Sub ValidarCampos()
Dim r As Long
Dim c As Long
Dim i As Long
Dim Error As String
Dim ws As Worksheet
Dim ValorMensaje As Long
'Turn off Screen refresh
Application.ScreenUpdating = False
'Use Cells(Row, Column) for range adddress
r = ActiveCell.Row
c = ActiveCell.Column
For i = 1 To Sheets.Count
'Use ws as worksheet(sheet number)
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
Set ws = Worksheets(i)
'r = ws.Range("a65536").End(xlUp).Row
' ws.Range("A1").Value = frmTomarDatos.txtNombre.Value
Error = "napaka v datumu"
If Len(frmTomarDatos.txtNombre.Text) = 0 Then
ValorMensaje = MsgBox("El campo Nombre est? vac?o", vbOKOnly, Error)
frmTomarDatos.txtNombre.SetFocus
' Was error so exit sub to correct error
Exit Sub
Else
If Len(frmTomarDatos.txtApellidos.Text) = 0 Then
ValorMensaje = MsgBox("vnesi podatke", vbOKOnly, Error)
frmTomarDatos.txtApellidos.SetFocus
' Was error so exit sub to correct error
Exit Sub
Else
' st is used elewhere?
st = frmTomarDatos.txtNombre.Text * 1
With ws.Cells(r, c)
.Value = txtNombre * 1
.Offset(0, 1).Value = frmTomarDatos.txtApellidos.Value
.Offset(0, 2).Value = frmTomarDatos.txtEntidad.Value * 1
.Offset(0, 3).Value = frmTomarDatos.txtOficina.Value
.Offset(0, 4).Value = frmTomarDatos.txtControl.Value
.Offset(0, 5).Value = frmTomarDatos.txtCuenta.Value
End With
'**************************************************
'Don't know what this does!
' ActiveCell.Offset(1, 0).Activate
' BorrarFormulario
'**************************************************
End If
End If
Next i
'Turn Screen refresh on
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
txtNombre.Value = Null
' txtNombre.Value = Null
txtApellidos.Value = Null
txtEntidad.Value = Null
txtOficina.Value = Null
txtControl.Value = Null
txtCuenta.Value = Null
End Sub
Private Sub BorrarFormulario()
'Ponemos la cadena vac?a
'a todos los campos
txtNombre.Text = ""
txtApellidos.Text = ""
txtEntidad.Text = ""
txtOficina.Text = ""
txtControl.Text = ""
txtCuenta.Text = ""
'Situamos el foco en el campo Nombre
txtNombre.SetFocus
End Sub
But the problem is I would like to put records in free rows not to overwrite the existing ones
ex: in sheet1 I add record to free row(lets say in 6 row) it works fine but when I look into other sheets it adds data but it overwrites sixth row and i dont wanna do that I would like to put this data in free row (not in the same row as in sheet1).
And when this is done I would like to delete data added in sheets where cells in G column says "Zaseden" and is higlighted with red
thnx for any advice