Foros del Web » Soporte técnico » Ofimática »

Funcion Duplicar Registros en Acces

Estas en el tema de Funcion Duplicar Registros en Acces en el foro de Ofimática en Foros del Web. Saludos, Estoi trabajando en un proyecto para poder hacer unas etiquetas. La question es que haveces son necesarias hacer duplicados en una misma pagina, por ...
  #1 (permalink)  
Antiguo 07/06/2011, 04:14
 
Fecha de Ingreso: junio-2011
Mensajes: 1
Antigüedad: 12 años, 10 meses
Puntos: 0
Exclamación Funcion Duplicar Registros en Acces

Saludos,

Estoi trabajando en un proyecto para poder hacer unas etiquetas. La question es que haveces son necesarias hacer duplicados en una misma pagina, por lo que necesito duplicarlas, tengo un boton que funciona a traves de un check box, donde pones si quieres duplicados, y cuantos, el problema esque no consigo que me lo haga por lo que ahora mismo me da error de "No coinciden los tipos" he probado y no consigo encontrar el porque, tiene que ver algo con el campo de bultos.

Adjunto codigo:

Cita:
Private Sub Ok_Click()
On Error GoTo Err_Ok_Click
Dim num_bultos
Dim error
Dim bultos As Integer
Dim i
Dim z
Dim num_copias
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
i = 1
z = 1
error = "no"




DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * from etiquetador")

txtempresa.SetFocus
txtempresa.Text = UCase(txtempresa.Text)
If txtempresa.Text = "" Then
aviso = MsgBox("Introduzca la empresa destinataria", vbCritical)
error = "si"
End If
txtdir.SetFocus
txtdir.Text = UCase(txtdir.Text)
If txtdir.Text = "" Then
aviso = MsgBox("Introduzca la dirección", vbCritical)
error = "si"
End If
txtcp.SetFocus
If txtcp.Text = "" Then
aviso = MsgBox("Introduzca el código postal", vbCritical)
error = "si"
End If
txtpob.SetFocus
txtpob.Text = UCase(txtpob.Text)
If txtpob.Text = "" Then
aviso = MsgBox("Introduzca la población", vbCritical)
error = "si"
End If
txtprov.SetFocus
txtprov.Text = UCase(txtprov.Text)
If txtprov.Text = "" Then
aviso = MsgBox("Introduzca la provincia", vbCritical)
error = "si"
End If
txtref.SetFocus
txtref.Text = UCase(txtref.Text)
If txtref.Text = "" Then
aviso = MsgBox("Introduzca la referencia del producto", vbCritical)
error = "si"
End If
txtbultos.SetFocus
If txtbultos.Text = "" Then
aviso = MsgBox("Introduzca nº de bultos", vbCritical)
error = "si"
End If

If error = "no" Then
rs.Open "etiquetador", CurrentProject.Connection, adOpenDynamic, adLockBatchOptimistic

txtbultos.SetFocus
While i <= bultos
bultos = i & "/" & bultos
rs.AddNew
txtempresa.SetFocus
rs!empresa = txtempresa.Text
txtdir.SetFocus
rs!direccion = txtdir.Text
txtcp.SetFocus
rs!cp = txtcp.Text
txtpob.SetFocus
rs!poblacion = txtpob.Text
txtprov.SetFocus
rs!provincia = txtprov.Text
txtref.SetFocus
rs!referencia = txtref.Text
txtbultos.SetFocus
rs!bultos = bultos
rs.UpdateBatch
i = i + 1
Wend
rs.Close

''''Si se quiere imprimir
If timp.Value = True Then
DoCmd.OpenReport "Informe", acViewNormal
End If

If tcop.Value = True Then
rs.Open "etiquetador", CurrentProject.Connection, adOpenDynamic, adLockBatchOptimistic

txtbultos.SetFocus
If IsNumeric(txtbultos.Text) Then

bultos = CInt(txtbultos.Text)
Dim intCopia As Integer
txtcopia.SetFocus
intCopia = txtcopia.Text
While z <= intCopia
While i <= bultos
bultos = i & "/" & bultos
rs.AddNew
txtempresa.SetFocus
rs!empresa = txtempresa.Text
txtdir.SetFocus
rs!direccion = txtdir.Text
txtcp.SetFocus
rs!cp = txtcp.Text
txtpob.SetFocus
rs!poblacion = txtpob.Text
txtprov.SetFocus
rs!provincia = txtprov.Text
txtref.SetFocus
rs!referencia = txtref.Text
txtbultos.SetFocus
rs!bultos = bultos
rs.UpdateBatch
i = i + 1
Wend
z = z + 1
Wend
Else

aviso = MsgBox("Error de datos en los Bultos", vbCritical)
End If

rs.Close
End If

''''''''''''''''''''''''
MsgBox ("Etiquetas actualizadas")
DoCmd.Close
End If
Exit_Ok_Click:
Exit Sub

Err_Ok_Click:
MsgBox Err.Description
Resume Exit_Ok_Click
End Sub
Saludos y gracias por adelantado.

Etiquetas: duplicar, funcion, registros
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 15:45.