Le voy a dejar algo fantástico que no es de mi autoría, pero lo utilizaba cuando trabajaba con tablas vinculadas a Access.
FORMULARIO
Al llamar la función le indico el nombre de los campos que no debe REPETIR, en este ejemplo le digo que no repita los campos Impuestos y Envío. Hago clic en Adicionar y obtengo.
Observe que aparece el registro 41 y los campos están en cero.
CÓDIGO DEL BOTON ADICIONAR
Private Sub btnAdiconar_Click()
Dim strMsg As String
DoCmd.GoToRecord , , acNewRec
Call RepiteUltimo(Me, strMsg, "Impuestos", "Envío")
If strMsg <> vbNullString Then
MsgBox strMsg, vbInformation
End If
End Sub
Observe como llamo la función RepiteUltimo() y anoto los 2 campos que no quiero se repitan. Si quiere que no se repita otro campo basta con adiconarlo separado por coma.
MÓDULO DE LA FUNCIÓN (Copie este código en un módulo)
Public Function RepiteUltimo(frm As Form, strErrMsg As String, ParamArray avarExceptionList()) As Long
On Error GoTo Err_Handler
'Purpose: Carry over the same fields to a new record, based on the last record in the form.
'Arguments: frm = the form to copy the values on.
' strErrMsg = string to append error messages to.
' avarExceptionList = list of control names NOT to copy values over to.
'Return: Count of controls that had a value assigned.
'Usage: In a form's BeforeInsert event, excluding Surname and City controls:
' Call CarryOver(Me, strMsg, "Surname", City")
Dim rs As DAO.Recordset 'Clone of form.
Dim ctl As Control 'Each control on form.
Dim strForm As String 'Name of form (for error handler.)
Dim strControl As String 'Each control in the loop
Dim strActiveControl As String 'Name of the active control. Don't assign this as user is typing in it.
Dim strControlSource As String 'ControlSource property.
Dim lngI As Long 'Loop counter.
Dim lngLBound As Long 'Lower bound of exception list array.
Dim lngUBound As Long 'Upper bound of exception list array.
Dim bCancel As Boolean 'Flag to cancel this operation.
Dim bSkip As Boolean 'Flag to skip one control.
Dim lngKt As Long 'Count of controls assigned.
'Initialize.
strForm = frm.Name
strActiveControl = frm.ActiveControl.Name
lngLBound = LBound(avarExceptionList)
lngUBound = UBound(avarExceptionList)
'No debe asignar valores a los controles del formulario si no se encuentra en un nuevo registro.
If Not frm.NewRecord Then
bCancel = True
strErrMsg = strErrMsg & "No se pueden transferir valores. Formulario '" & strForm & "' no es un nuevo registro." & vbCrLf
End If
'Busque el registro para copiar, verificando que haya uno.
If Not bCancel Then
Set rs = frm.RecordsetClone
If rs.RecordCount <= 0& Then
bCancel = True
strErrMsg = strErrMsg & "No se pueden transferir valores. Formulario '" & strForm & "' no tiene registros." & vbCrLf
End If
End If
If Not bCancel Then
'El último registro del formulario es el que se va a copiar.
rs.MoveLast
'Hace un bucle con los controles.
For Each ctl In frm.Controls
bSkip = False
strControl = ctl.Name
'Ignore el control activo, aquellos sin ControlSource y aquellos en la lista de excepciones.
If (strControl <> strActiveControl) And HasProperty(ctl, "ControlSource") Then
For lngI = lngLBound To lngUBound
If avarExceptionList(lngI) = strControl Then
bSkip = True
Exit For
End If
Next
If Not bSkip Then
'Examine a qué está destinado este control. No haga caso de no enlazado o enlazado a una expresión.
strControlSource = ctl.ControlSource
If (strControlSource <> vbNullString) And Not (strControlSource Like "=*") Then
'Ignore los campos calculados (sin SourceTable), los campos de numeración automática y los valores nulos.
With rs(strControlSource)
If (.SourceTable <> vbNullString) And ((.Attributes And dbAutoIncrField) = 0&) _
And Not (IsCalcTableField(rs(strControlSource)) Or IsNull(.Value)) Then
If ctl.Value = .Value Then
'hacer nada. (Omitir esto puede causar el error 3331).
Else
ctl.Value = .Value
lngKt = lngKt + 1&
End If
End If
End With
End If
End If
End If
Next
End If
RepiteUltimo = lngKt
Exit_Handler:
Set rs = Nothing
Exit Function
Err_Handler:
strErrMsg = strErrMsg & Err.Description & vbCrLf
Resume Exit_Handler
End Function
Private Function IsCalcTableField(fld As DAO.Field) As Boolean
'Propósito: Devuelve True si fld es un campo calculado (solo Access 2010 y versiones posteriores).
On Error GoTo ExitHandler
Dim strExpr As String
strExpr = fld.Properties("Expression")
If strExpr <> vbNullString Then
IsCalcTableField = True
End If
ExitHandler:
End Function
Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Propósito: Devuelve verdadero si el objeto tiene la propiedad.
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Functio
Esto le sirve para todos sus formularios. Si quiere el ejemplo lo puede solicitar a [email protected]. Favor en el asunto anotar la consulta.