Какая-то фигня получается... Если я люблю пользоваться клавиатурой, как я узнаю, что фокус на слайдере? Не солидно.

Public Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" ( _
       ByVal hWnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       lParam As Any) As Long

'* These are used in every form to ensure focus rectangle visibility
Public Const WM_CHANGEUISTATE As Long = &H127
Public Const UIS_CLEAR As Integer = &H2
Public Const UISF_HIDEFOCUS As Integer = &H1

Private Sub Form_Load()
   Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
       MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
End Sub

Private_Юзер_TAB_или_чего_там_положено_Первый_Раз_Нажал()
   Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
       MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
End Sub

 'KeyPreview=True для формы
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  msgbox KeyCode
End Sub

Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
    MsgBox KeyCode
End Sub

Dim KeyInit  as boolean
KeyInit=false
Private_Особый_Случай(клавиатура as boolean) //перевод фокуса
   If not(KeyInit) then
     If клавиатура then
        Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
          MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
        KeyInit=true
     EndIf
  EndIf
End Sub

Declare Function GetKeyboardState Lib _ 
        "user32" (pbKeyState As Byte) _ 
        As Long 
Declare Function SetKeyboardState Lib _ 
        "user32" (lppbKeyState As Byte) _ 
        As Long 

Public Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
'---------------------------------------------------------------
Dim bViewFocus As Boolean

Private Sub Form_Load()
    bViewFocus = True
End Sub

Private Sub Option1_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Option2_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Option3_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Command1_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Command2_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Check1_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub
Private Sub Combo1_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub

'Form1
Private Sub Form_Load()
    StartForm1KeyHook 'а вдруг user любит клавиатуру?
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopForm1KeyHook 'если user не любит клавиатуру
End Sub
'Module
'========================================
Private Const WH_KEYBOARD =  2 

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
  (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
  ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private mlngForm1HookId As Long

Public Sub StartForm1KeyHook()
    mlngForm1HookId = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyProcForm1, App.hInstance, App.ThreadID)
End Sub

Public Sub StopForm1KeyHook()
    UnhookWindowsHookEx mlngForm1HookId
End Sub

Private Function KeyProcForm1(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Form1.Caption = wParam  'Chr$(wParam)
    If (wParam = vbKeyTab) Or (wParam = vbKeyLeft) Or (wParam = vbKeyRight) Or (wParam = vbKeyUp) _
      Or (wParam = vbKeyDown) Then
        Call SendMessage(Form1.hWnd, WM_CHANGEUISTATE, _
          MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
        StopForm1KeyHook 'если user любит клавиатуру
        Exit Function
    End If
    KeyProcForm1 = CallNextHookEx(mlngForm1HookId, ncode, wParam, lParam)
End Function

Private Sub Любой_Элемент_of_Form1_LostFocus()
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
            bViewFocus = False
        End If
    End If
End Sub

Private Sub Form_Load() 'Form2
    StartForm2KeyHook 'а вдруг user любит клавиатуру?
End Sub

Private Sub Form_Unload(Cancel As Integer) 'Form2
    StopForm2KeyHook 'если user не любит клавиатуру
End Sub

Private Sub Form_Load() 'Form2
    StopForm1KeyHook 'чтоб не перехватывалось главным окном
    StartForm2KeyHook 'а вдруг user любит клавиатуру?
End Sub

Private Sub Form_Unload(Cancel As Integer) 'Form2
    StopForm2KeyHook 'если user не любит клавиатуру
    StartForm1KeyHook 'возврат к главному окну
End Sub

For all element in the form.elements
    element.add to collection
next

For all element in the form.elements
    If (есть событие _lostfocus) то
         element.add to collection
    End If
next

For each ctl in Me.Controls
   If ctl.HaveEvent (lostfocus) then
      MyCols.Add ctl
   end if
Next

Option Explicit
'Для представления элементов в виде коллекции
Dim cElement As New Collection

Public Event LostFocus()

Sub Add(ctl As Control)
    cElement.Add ctl
End Sub

Option Explicit
Private WithEvents Myctl As VBControlExtender
Dim MyCols As MyNewCollection 'class собственной коллекции'

Private Sub Form_Load()
  Dim ctl As Control
  For Each ctl In Me.Controls
     MyCols.Add ctl 'Ругается, скотина
  Next
  Set Myctl = MyCols
End Sub

'ClassFocus
Option Explicit

Public Parent As Form
Public WithEvents CheckBox As CheckBox
Public WithEvents ComboBox As ComboBox
Public WithEvents CommandButton As CommandButton
Public WithEvents ListView As ListView
Public WithEvents OptionButton As OptionButton
Public WithEvents TextBox As TextBox
Public WithEvents TreeView As TreeView

Private Sub CheckBox_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub ComboBox_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub CommandButton_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub ListView_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub OptionButton_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub TextBox_LostFocus()
    Parent.FocusRectangles
End Sub

Private Sub TreeView_LostFocus()
    Parent.FocusRectangles
End Sub

Public Sub Class_Terminate()
    Set Parent = Nothing
    Set CheckBox = Nothing
    Set ComboBox = Nothing
    Set CommandButton = Nothing
    Set ListView = Nothing
    Set OptionButton = Nothing
    Set TextBox = Nothing
    Set TreeView = Nothing
End Sub

Option Explicit

Private TBEvents() As ClassFocus

Private Sub Form_Load()
    Dim Ctr As Control, Count As Long
    For Each Ctr In Me.Controls
        If (TypeOf Ctr Is CheckBox) Or (TypeOf Ctr Is ComboBox) Or (TypeOf Ctr Is CommandButton) Or _
          (TypeOf Ctr Is ListView) Or (TypeOf Ctr Is OptionButton) Or (TypeOf Ctr Is TextBox) Or _
          (TypeOf Ctr Is TreeView) Then
            ReDim Preserve TBEvents(Count)
            Set TBEvents(Count) = New ClassFocus
            Set TBEvents(Count).Parent = Me
            If (TypeOf Ctr Is CheckBox) Then
                Set TBEvents(Count).CheckBox = Ctr
            ElseIf (TypeOf Ctr Is ComboBox) Then
                Set TBEvents(Count).ComboBox = Ctr
            ElseIf (TypeOf Ctr Is CommandButton) Then
                Set TBEvents(Count).CommandButton = Ctr
            ElseIf (TypeOf Ctr Is ListView) Then
                Set TBEvents(Count).ListView = Ctr
            ElseIf (TypeOf Ctr Is OptionButton) Then
                Set TBEvents(Count).OptionButton = Ctr
            ElseIf (TypeOf Ctr Is TextBox) Then
                Set TBEvents(Count).TextBox = Ctr
            ElseIf (TypeOf Ctr Is TreeView) Then
                Set TBEvents(Count).TreeView = Ctr
            End If
            Count = Count +  1 
        End If
    Next
    Set Ctr = Nothing
    Form2.Visible = True
End Sub

Sub FocusRectangles()
    Dim i As Integer
    'если user любит клавиатуру
    If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
      (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
        MsgBox "ok"
        Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
          MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
    End If
    For i =  0  To Count -  1 
        TBEvents(i).Class_Terminate
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'если user не любит клавиатуру
    Dim i As Integer
    For i =  0  To Count -  1 
        TBEvents(i).Class_Terminate
    Next i
End Sub

        For i =  0  To Count -  1 
            TBEvents(i).Class_Terminate
        Next i

Dim bViewFocus As Boolean

Private Sub Form_Load()
...
    bViewFocus = True


...
Sub FocusRectangles()
    'если user любит клавиатуру
    If bViewFocus Then
        If (GetKeyState(vbKeyTab) <  0 ) Or (GetKeyState(vbKeyLeft) <  0 ) Or _
          (GetKeyState(vbKeyUp) <  0 ) Or (GetKeyState(vbKeyRight) <  0 ) Or (GetKeyState(vbKeyDown) <  0 ) Then
            Call SendMessage(Me.hWnd, WM_CHANGEUISTATE, _
              MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), ByVal  0 )
              bViewFocus = False
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    For i =  0  To Count -  1 
        On Error Resume Next
        Set TBEvents(i) = Nothing
    Next i
End Sub