Duplicar un registro del mismo formulario

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.Close

b) 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 Sub

Este 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 Sub

Muchas 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.