Private Sub Товар_GotFocus()
    On Error Resume Next
        Dim id As Long
'    Me.TA1 = id' комент

   id = Nz(Me.Товар,  0 )
        Col.Add id, CStr(id)
Me.Recalc
End Sub

Private Sub Товар_LostFocus()
    On Error Resume Next
        Dim id As Long
'    Me.TA1 = id' комент

   id = Nz(Me.Товар,  0 )
       Col.Remove CStr(id)

End Sub

Private Sub Товар_GotFocus()
    On Error Resume Next
        Dim id As Long
'    Me.TA1 = id' комент

   id = Nz(Me.Товар,  0 )
        Col.Add id, CStr(id)
Application.Echo =false
Me.Recalc
Application.Echo= true
End Sub

Private Sub Товар_LostFocus()
    On Error Resume Next
        Dim id As Long
'    Me.TA1 = id' комент

   id = Nz(Me.Товар,  0 )
       Col.Remove CStr(id)

End Sub

Private Sub Товар_GotFocus()
    On Error Resume Next
        Dim id As Long

   id = Nz(Me.Товар,  0 )
        Col.Add id, CStr(id)

Me.Painting = False
Me.Recalc
Me.Painting = True
End Sub

Private Sub Товар_LostFocus()
    On Error Resume Next
        Dim id As Long
'    Me.TA1 = id

   id = Nz(Me.Товар,  0 )
       Col.Remove CStr(id)

End Sub

Private Sub Товар_GotFocus()
On Error Resume Next
  CurID = Nz(Me.Товар,  0 ) 'запомним текущий ID
'  Me.Recalc
  Me!Товар = Me!Товар 'эта строка сгенерирует перерисовку (вызов "Гришанов-метода")
  'только текущей строки (со всеми косяками, которые могут обнаружиться в многопользовательском приложении)
  DoCmd.RunCommand acCmdSaveRecord 'а эта зафиксирует изменения
End Sub

Public Function ppic(ByVal id As Long, VAR1 As Variant) As Variant
Dim dd As Long
  'проверяем, не текущая ли позиция курсора
  If CurID = id Then
    ppic = rst!pic 'здесь может быть одна картинка (цвет текущего курсора)
  Else
    'проверяем, не выбранная ли запись
    If InCol(id) Then
      ppic = rst!pic  'здесь может быть другая картинка (цвет выделения выбранных записей)
    Else
      ppic = Nothing
    End If
  End If
End Function

Public Function ppic(ByVal id As Long, VAR1 As Variant) As Variant
Dim dd As Long
  'проверяем, не текущая ли позиция курсора
  If CurID = id Then
    ppic = rst!pic 'здесь может быть одна картинка (цвет текущего курсора)
  Else
    'проверяем, не выбранная ли запись
    If InCol(id) Then
      ppic = rst!pic  'здесь может быть другая картинка (цвет выделения выбранных записей)
    Else
      ppic = Nothing
    End If
  End If
End Function

            Case vbKeyDown
                KeyCode =  0 
                ti = timeGetTime
                Debug.Print  "1   " & ti
                Call MoveMe(False)
                Debug.Print  "10   " & timeGetTime - ti

Public Function ppic(ByVal id As Long, ss As Long) As Variant
Dim dd As Long
On Error GoTo s1
Debug.Print  "8   " & timeGetTime - ti

If InCol(id) Then
ppic = rst!pic
Else
ppic = Null
End If
Debug.Print  "9   " & timeGetTime - ti
Exit Function
s1:
MsgBox Err.Description
End Function