Duplicar un registro del mismo formulario
Estoy intentando replicar un ejemplo que he visto para duplicar un registro del mismo formulario, pero me da error, y no sé dónde está el fallo. El código es el siguiente:
Private Sub CmdCopiar_Click()
Dim vUltimo As Variant
Dim vAño As Long
'Le damos a la variable vAño el valor del año actual: Las dos cifras finales
vAño = Val(Right(Year(Date), 2))
'vUltimo es igual al Número de Registros del año +1, que se sumará abajo
vUltimo = Nz(DCount("[CodigoPresupuesto]", "[TPresupuestos]", "[Año] = " & Year(Date)), 0)
'Si vUltimo es nulo, es porque no hay ningún NumJustifica, entonces le damos valor 0
If IsNull(vUltimo) Then
vUltimo = 0
End If
'Sumamos 1 al valor anterior
vUltimo = vUltimo + 1
CodigoPresupuesto = "P-" & vAño & "-" & Format(vUltimo, "00000")
Dim strSQL As String
Dim lngSiguiente As Long
LngSiguiente = DMax("id", "TPresupuestos") + 1
strSQL = "INSERT INTO TPresupuestos ( id, CodigoPresupuesto, CodigoCliente, FechaSolicitud, Observaciones, Año, CodigoComercial, CodigoFormaDePago, Transporte, Montaje, Obra, CodigoEstado, EsDeposito, Deposito, PorcentajeDeBeneficio, CodigoFactura, CodigoIVATransporte, CodigoIVAMontaje, IVAPresupuestos, TransporteProrrateado, CodigoTipoDePresupuesto, CodigoProveedor, EsTransporteInternacional )"
strSQL = strSQL & " SELECT " & lngSiguiente & " , CodigoPresupuesto, CodigoCliente, FechaSolicitud, Observaciones, Año, CodigoComercial, CodigoFormaDePago, Transporte, Montaje, Obra, CodigoEstado, EsDeposito, Deposito, PorcentajeDeBeneficio, CodigoFactura, CodigoIVATransporte, CodigoIVAMontaje, IVAPresupuestos, TransporteProrrateado, CodigoTipoDePresupuesto, CodigoProveedor, EsTransporteInternacional"
strSQL = strSQL & " FROM TPresupuestos"
strSQL = strSQL & " WHERE CodigoPresupuesto = " & Me.CodigoPresupuesto
CurrentDb.Execute strSQL, dbFailOnError
StrSQL = "INSERT INTO TPresupuestosSubtabla ( ID, CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo )"
strSQL = strSQL & " SELECT " & lngSiguiente & " , CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo"
strSQL = strSQL & " FROM TPresupuestosSubtabla"
strSQL = strSQL & " WHERE CodigoPresupuesto = " & Me.CodigoPresupuesto
CurrentDb.Execute strSQL, dbFailOnErrorAhí tenéis el fallo:
Cuando pongo en un campo "Codigo...", es mi manera de saber que ese campo está relacionado con otro del mismo nombre de otra tabla. Asimismo, necesito que cree un nuevo código de presupuesto, de ahí el código del principio, pero ¿cómo lo meto?
1 Respuesta
Sugerencias:
1º/ El valor que le pasas al ID y que calculas con VBA, mejor si lo pasas así, con un alias:
strSQL = strSQL & " SELECT " & lngSiguiente & " AS elID, CodigoPresupuesto, ..."
2º/ Si el campo ID en la tablas es autonumérico, no le puedes asignar tu el valor.
3º/ Yo haría un "debug.Print strSQL" antes del CurrentDb. Execute, y así vería la SQL que creas y si falta algo o hay algo qe no cuadra.
4º/ Muy posiblemente el problema esté en el campo CodigoPresupuesto, pues al ejecutar la SQL aún no se ha guardado el registro y por tanto no existe ese valor en la tabla. Prueba a guardar antes de ejecutar las SQL el registro (con DoCmd. RunCommand acCmdSaveRecord, por ejemplo), o también puedes pasarle el valor a la SQL igual que haces con lngSiguiente :
strSQL = strSQL & " SELECT " & lngSiguiente & " AS elID, '" & CodigoPresupuesto & "' AS elCodigoPresup, ...",
Hola, muchas gracias por tu explicación. Ya casi lo tengo funcionando. Hay dos detalles que me fallan. He conseguido que me copie los valores de la tabla principal (TPresupuestos), y uno de la tabla secundaria (TPresupuestosSutabla), mediante el siguiente código:
CurrentDb.Execute "Insert into TPresupuestos (CodigoPresupuesto, CodigoCliente, FechaSolicitud, Observaciones, Año, CodigoComercial, CodigoFormaDePago, Transporte, Montaje, Obra, CodigoEstado, EsDeposito, Deposito, PorcentajeDeBeneficio, CodigoFactura, CodigoIVATransporte, CodigoIVAMontaje, IVAPresupuestos, TransporteProrrateado, CodigoTipoDePresupuesto, CodigoProveedor, EsTransporteInternacional ) " _
& " values ('" & CodigoPresupuesto & "', '" & Me.CodigoCliente & "', #" & Me.FechaSolicitud & "#, '" & Me.Observaciones & "', " & Me.Año & ", '" & Me.CodigoComercial & "', '" & Me.CodigoFormaDePago & "', " & Me.Transporte & ", " & Me.Montaje & ", '" & Me.Obra & "', '" & Me.CodigoEstado & "', " & Me.EsDeposito & ", " & Me.Deposito & ", " & Me.PorcentajeDeBeneficio & ", '" & Me.CodigoFactura & "', '" & Me.CmbIVATransporte & "', '" & Me.CmbIVAMontaje & "', '" & 1 & "', " & Me.TransporteProrrateado & ", '" & Me.CodigoTipoDePresupuesto & "', '" & Me.CodigoProveedor & "', " & Me.ChkTransporteInternacional & ")"
CurrentDb.Execute "Insert into TPresupuestosSubtabla (CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo ) " _
& " values ('" & CodigoPresupuesto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Cantidad & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Caracteristicas & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Concepto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!CmbIVA & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Imagen1 & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Posicion & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!ChkEsPorcentajeDeBenficioArticulo & ", " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPorcentajeDeBeneficioArticulo & ")"Entonces, mis dos problemas son los siguientes:
1. ¿Cómo actualizo el formulario para que me aparezca el nuevo registro?
2. ¿Cómo puedo hacer para copiar todos los registros de TPresupuestosSubtabla asociados a un CodigoPresupuesto?
Un saludo.
No puedo ver tu respuesta
No hagas caso al último mensaje, que me he equivocado.
Te respondo:
1º/ Para actualizar el formulario y que aparezca el nuevo registro, basta hacerle un simple Me. Requery. Luego si te quieres ir al registro nuevo, con DoCmd. GoToRecord,, acLast (entiendo que el nuevo registro será el último), o usando un recordset y bookmark.
2º/ Yo lo haría con INSERT INTO SELECT, como en tu primer intento (ahora veo que ya no le pasas un valor al id).
Si lo quieres hacer registro a registro, tienes opciones:
a) Crear un recordset sobre el subformulario y recorrerlo hasta el final ejecutando la SQL en cada pasada:
Set rst=Me.FPresupuestosSubformulario.Form.RecordsetClone
Do Until rt.EOF
CurrentDb. Execute "Insert into TPresupuestosSubtabla (CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo ) " _
& " values ('" & CodigoPresupuesto & "', " & rst!Cantidad & ", '" & rst!Caracteristicas & "', '" & rst!Concepto & "', " & rst!TxtPrecioCoste & ", '" & rst!CmbIVA & "', '" & rst!Imagen1 & "', '" & rst!Posicion & "', " & rst!ChkEsPorcentajeDeBenficioArticulo & ", " & rst!TxtPorcentajeDeBeneficioArticulo & ")"
rst.MoveNext
Loop
rst.Closeb) Hacer un for next que se mueva por el subform y ejecutar la SQL en cada pasada:
Me.FPresupuestosSubformulario.SetFocus
For i = 1 To Me.FPresupuestosSubformulario.Form.RecordsetClone.RecordCount
CurrentDb. Execute "Insert into TPresupuestosSubtabla (CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo ) " _
& " values ('" & CodigoPresupuesto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Cantidad & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Caracteristicas & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Concepto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!CmbIVA & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Imagen1 & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Posicion & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!ChkEsPorcentajeDeBenficioArticulo & ", " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPorcentajeDeBeneficioArticulo & ")"
DoCmd.GoToRecord , , acNext
Next i
Me. CmdCopiar. SetFocus
Hola, muchas gracias. Te cuento, mezclando código de aquí y de allí, fallando, probando, he llegado a este código:
Private Sub CmdCopiar_Click()
Dim strSql As String
Dim lngID As String
Dim vUltimo As Variant
Dim vAño As Long
Dim ElCodigoPresupuesto As String
Me.Filter = ""
Me.FilterOn = False
'Me.Requery
'Le damos a la variable vAño el valor del año actual: Las dos cifras finales
vAño = Val(Right(Year(Date), 2))
'vUltimo es igual al Número de Registros del año +1, que se sumará abajo
vUltimo = Nz(DCount("[CodigoPresupuesto]", "[TPresupuestos]", "[Año] = " & Year(Date)), 0)
'Si vUltimo es nulo, es porque no hay ningún NumJustifica, entonces le damos valor 0
If IsNull(vUltimo) Then
vUltimo = 0
End If
'Sumamos 1 al valor anterior
vUltimo = vUltimo + 1
ElCodigoPresupuesto = "P-" & vAño & "-" & Format(vUltimo, "00000")
If Me.Dirty Then
Me.Dirty = False
End If
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
With Me.RecordsetClone
.AddNew
!CodigoPresupuesto = ElCodigoPresupuesto
!CodigoCliente = Me.CodigoCliente
!FechaSolicitud = Me.FechaSolicitud
!Observaciones = Me.Observaciones
!Año = Year(Date)
!CodigoComercial = Me.CodigoComercial
!CodigoFormaDePago = Me.CodigoFormaDePago
!Transporte = Me.Transporte
!Montaje = Me.Montaje
!Obra = Me.Obra
!PorcentajeDeBeneficio = Me.PorcentajeDeBeneficio
!Deposito = Me.Deposito
!CodigoIVATransporte = Me.CmbIVATransporte
!CodigoIVAMontaje = Me.CmbIVAMontaje
!EsTransporteInternacional = Me.ChkTransporteInternacional
!TransporteProrrateado = Me.TransporteProrrateado
!CodigoTipoDePresupuesto = Me.CodigoTipoDePresupuesto
!CodigoProveedor = Me.CodigoProveedor
.Update
.Bookmark = .LastModified
lngID = !CodigoPresupuesto
If Me.[FPresupuestosSubformulario].Form.RecordsetClone.RecordCount > 0 Then
Me.FPresupuestosSubformulario.SetFocus
For i = 1 To Me.FPresupuestosSubformulario.Form.RecordsetClone.RecordCount
CurrentDb.Execute "Insert into TPresupuestosSubtabla (CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo ) " _
& " values ('" & ElCodigoPresupuesto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Cantidad & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Caracteristicas & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Concepto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!CmbIVA & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Imagen1 & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Posicion & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!ChkEsPorcentajeDeBenficioArticulo & ", " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPorcentajeDeBeneficioArticulo & ")"
DoCmd.GoToRecord , , acNext
Next i
Me.CmdCopiar.SetFocus
Else
MsgBox "Main record duplicated, but there were no related records."
End If
Me.Bookmark = .LastModified
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
Resume Exit_Handler
End SubEste código me copia el registro del formulario principal y el primero del subformulario sin problemas.
El problema está en el subformulario. Aquí:
CurrentDb.Execute "Insert into TPresupuestosSubtabla (CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo ) " _
& " values ('" & ElCodigoPresupuesto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Cantidad & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Caracteristicas & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Concepto & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste & ", '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!CmbIVA & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Imagen1 & "', '" & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!Posicion & "', " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!ChkEsPorcentajeDeBenficioArticulo & ", " & Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPorcentajeDeBeneficioArticulo & ")"Si lo dejo así, me dice que el número de valores de consulta y el número de campos de destino son diferentes.
He añadido puntos de interrupción, y he grabado un vídeo para que veas lo que hace:
https://mega.nz/file/EQUVzKzb#vYUoPSdE5P49EQcAfLNlSwQhKvF7lvUh3FQ35mT93a8
¿Qué es lo que estoy haciendo mal?
Si cambio a uno el número de veces que tiene que pasar por el subformulario, me funciona perfectamente. Así que solo tengo que pulir ese error que me está dando.
Por cierto, no me funcionaba porque tenía metido un filtro al abrir el formulario. El cliente para el que se lo estoy haciendo trabaja sobre la base de un presupuesto, y lo hemos dividido en cuatro: aceptado, denegado, facturado y pendiente. Cuando se agrega un nuevo presupuesto, el estado es pendiente. De ahí que, al abrir el formulario, le tuviera puesto un filtro para mostrar solo los pendientes. Así que lo que he quitado, y he creado un consulta con ese filtro. Esto me obliga a que, si quiero que en el mismo formulario el cliente pueda ver las otras opciones (aceptado, denegado o facturado), tenga que hacerlo vía código cambiando el origen del formulario.
Ya lo he conseguido. Al final ha sido así:
Private Sub CmdCopiar_Click()
Dim vUltimo As Variant
Dim vAño As Long
Dim ElCodigoPresupuesto As String
Dim strSql As String
Dim lngID As String
'Le damos a la variable vAño el valor del año actual: Las dos cifras finales
vAño = Val(Right(Year(Date), 2))
'vUltimo es igual al Número de Registros del año +1, que se sumará abajo
vUltimo = Nz(DCount("[CodigoPresupuesto]", "[TPresupuestos]", "[Año] = " & Year(Date)), 0)
'Si vUltimo es nulo, es porque no hay ningún NumJustifica, entonces le damos valor 0
If IsNull(vUltimo) Then
vUltimo = 0
End If
'Sumamos 1 al valor anterior
vUltimo = vUltimo + 1
ElCodigoPresupuesto = "P-" & vAño & "-" & Format(vUltimo, "00000")
If Me.Dirty Then
Me.Dirty = False
End If
If Me.NewRecord Then
MsgBox "Selecciona el presupuesto que quieres copiar.", vbInformation, NombreBD
Else
With Me.RecordsetClone
.AddNew
!CodigoPresupuesto = ElCodigoPresupuesto
!CodigoCliente = Me.CodigoCliente
!FechaSolicitud = Me.FechaSolicitud
!Observaciones = Me.Observaciones
!Año = Year(Date)
!CodigoComercial = Me.CodigoComercial
!CodigoFormaDePago = Me.CodigoFormaDePago
!Transporte = Me.Transporte
!Montaje = Me.Montaje
!Obra = Me.Obra
!PorcentajeDeBeneficio = Me.PorcentajeDeBeneficio
!Deposito = Me.Deposito
!CodigoIVATransporte = Me.CmbIVATransporte
!CodigoIVAMontaje = Me.CmbIVAMontaje
!EsTransporteInternacional = Me.ChkTransporteInternacional
!TransporteProrrateado = Me.TransporteProrrateado
!CodigoTipoDePresupuesto = Me.CodigoTipoDePresupuesto
!CodigoProveedor = Me.CodigoProveedor
.Update
.Bookmark = .LastModified
lngID = !CodigoPresupuesto
If Me.[FPresupuestosSubformulario].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO TPresupuestosSubtabla ( CodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo )"
strSql = strSql & " SELECT '" & lngID & "' As ElCodigoPresupuesto, Cantidad, Caracteristicas, Concepto, Precio, CodigoIVA, Imagen, Posicion, EsPorcentajeDeBeneficio, PorcentajeDeBeneficioArticulo"
strSql = strSql & " FROM TPresupuestosSubtabla"
strSql = strSql & " WHERE CodigoPresupuesto ='" & Me.CodigoPresupuesto & "'"
DBEngine(0)(0).Execute strSql, dbFailOnError
Else
MsgBox "Formulario principal copiado, pero no hay registros relacionados.", vbInformation, NombreBD
End If
Me.Bookmark = .LastModified
End With
End If
End SubMuchas gracias por la ayuda.
Un saludo.
A ver, el vídeo no lo puedo ver, dice que se ha borrado por infringir no sé qué normas... De todas formas, el error de que no coinciden el número de campos es muy probable que venga motivado porque alguno de tus campos numéricos tenga decimales, e interprete la coma decimal como separador de campos. La solución es muy simple: o usas Replace() para cambiar la coma por punto, o conviertes el dato a cadena de texto . Por ejemplo, si PrecioCoste es el que tiene valores decimales, harías:
& "', " & Replace(Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste,",",".") & ", '" &
o:
& "', " & Str(Forms![FPresupuestos]![FPresupuestosSubformulario].Form!TxtPrecioCoste) & ", '" &
Fíjate que aunque convertimos el valor a cadena de texto, al pasarlo en la SQL no lleva las comillas, porque el campo en la tabla sigue siendo numérico.
Ahhh, pues fíjate que he leído eso buscando la respuesta en una pregunta en esta misma página contestada por ti. Pero he pensado: "¿a mí? ¡yo no tengo ningún campo con decimales!". Y sí que los tengo, claro que sí. Vale, vale, muchas gracias por la aclaración.
Un saludo.
