Respuesta a pérdida del historial

En un modulo creas esta función:
----
Function AgregarTodoALaLista(ctl As Control, lngId As Long, lngFila As Long, _
LngCol As Long, entCódigo As Integer) As Variant
' Agregar "(Todos)" a la parte superior de un cuadro
' combinado o de un cuadro de lista.
' Puede agregar "(Todos)" a otra columna de un cuadro
' combinado o de un cuadro de lista estableciendo la
' propiedad Información adicional del control a otro
' número de columna, o puede mostrar un texto distinto
' de "(Todos)" agregando un punto y coma (;) y el texto
' que desea mostrar. Por ejemplo, estableciendo la propiedad
' Información adicional a "2;<Ninguno>" muestra "<Ninguno>"
' En la segunda columna de la lista.
Static bd As Database, rst As Recordset
Static lngIdMostrar As Long
Static intColMostrar As Integer
Static cadTextoMostrar As String
Dim entPuntoYComo As Integer
On Error GoTo Err_AgregarTodoALaLista
Select Case entCódigo
Case acLBInitialize
' Comprobar si la función está en uso.
If lngIdMostrar <> 0 Then
MsgBox "Otro control está utilizando AgregarTodoALaLista"
AgregarTodoALaLista = False
Exit Function
End If
' Analizar la columna a mostrar y el texto a mostrar de
' la propiedad Información adicional.
intColMostrar = 1
cadTextoMostrar = "(Todos)"
If Not IsNull(ctl.Tag) Then
entPuntoYComo = InStr(ctl.Tag, ";")
If entPuntoYComo = 0 Then
intColMostrar = Val(ctl.Tag)
Else
intColMostrar = Val(Left(ctl.Tag, entPuntoYComo - 1))
cadTextoMostrar = Mid(ctl.Tag, entPuntoYComo + 1)
End If
End If
' Abrir el conjunto de registros definido en la propiedad
' Origen de fila.
Set bd = CurrentDb
Set rst = bd.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
' Grabar y devolver lngId para esta función.
lngIdMostrar = Timer
AgregarTodoALaLista = lngIdMostrar
Case acLBOpen
AgregarTodoALaLista = lngIdMostrar
Case acLBGetRowCount
' Devolver el número de columnas del conjunto de registros.
On Error Resume Next
rst.MoveLast
AgregarTodoALaLista = rst.RecordCount + 1
Case acLBGetColumnCount
' Devolver el número de campos (columna) del conjunto de registros.
AgregarTodoALaLista = rst.Fields.Count
Case acLBGetColumnWidth
AgregarTodoALaLista = -1
Case acLBGetValue
If lngFila = 0 Then
If lngCol = intColMostrar - 1 Then
AgregarTodoALaLista = cadTextoMostrar
Else
AgregarTodoALaLista = Null
End If
Else
rst.MoveFirst
rst.Move lngFila - 1
AgregarTodoALaLista = rst(lngCol)
End If
Case acLBEnd
lngIdMostrar = 0
rst.Close
End Select
Salir_AgregarTodoALaLista:
Exit Function
Err_AgregarTodoALaLista:
MsgBox Err.Description, vbOKOnly + vbCritical, "AgregarTodoALaLista"
AgregarTodoALaLista = False
Resume Salir_AgregarTodoALaLista
End Function
---
El cuadro combinado debe tener entre otras las siguientes propiedades:
---
TipoDeOrigenDeLaFila
(RowSourceType) AgregarTodoALaLista
---
En el ejemplo también se explica que el evento después de actualizar del cuadro combinado puede ser algo como esto:
---
Private Sub SeleccionarCliente_AfterUpdate()
' Devolver los registros que cumplan el valor elegido en
' el cuadro combinado SeleccionarCliente.
If Len(Me!SeleccionarCliente.Column(1)) = 0 Then
DoCmd.ShowAllRecords
Else
DoCmd.ApplyFilter , "IdCliente = Forms!AgregarTodoALaLista!SeleccionarCliente"
End If
End Sub
---