Tab Index Order, Setting With VBA

B

Bob

The code below is supposed to assign control tab index order.
However, it bugs out in the FOR loop of the sub
SetTabsInPhoneBookOrder: 'Run-time error 2184: The value you used
for
the TabIndex property isn't valid. The correct values are from 0
through 9. I don't recall where I got the code and the author did
not
include his email address. I've search for his name and searched for
ways to assign tabindex via VBA (Access 2002), without luck. Any
help
would be appreciated.

Thanks for looking,
Bob


Option Compare Database
Option Explicit


Const CACHE_SIZE = 50


Sub CachingSyntax()
Dim rst As Recordset, lngCacheSize As Long


With rst
.CacheSize = CACHE_SIZE
.FillCache
Do While Not .EOF
'processing here
'
'
.MoveNext
lngCacheSize = lngCacheSize + 1
If lngCacheSize Mod CACHE_SIZE = 0 Then
.CacheStart = .Bookmark
.FillCache
End If
Loop
End With


End Sub


Sub SetTabsInPhoneBookOrder(frmName As String, Optional varPageName
As
Variant)
'by CRW @ DSW 092302
'uses 3 column array of |name|left|top| to set tab order of controls
on form or tab on form
'sorts controls by left then by top and assigns control's tabstop to
Nth position in array
Dim ctl As Control, i As Integer, j As Integer, fChanged As Boolean,
_
strName As String, dblLeft As Double, dblTop As Double


ReDim avarCtls(3, 0)
DoCmd.OpenForm frmName, acDesign
'load tab-able ctls to array
If IsMissing(varPageName) Then
For Each ctl In Forms(frmName)
If HasProperty(ctl, "TabIndex") Then
i = UBound(avarCtls, 2)
ReDim Preserve avarCtls(3, i + 1)
avarCtls(1, i + 1) = ctl.Name
avarCtls(2, i + 1) = ctl.Left
avarCtls(3, i + 1) = ctl.Top
End If
Next ctl
Else
For Each ctl In Forms(frmName).Controls(varPageName).Controls
If HasProperty(ctl, "TabIndex") Then
i = UBound(avarCtls, 2)
ReDim Preserve avarCtls(3, i + 1)
avarCtls(1, i + 1) = ctl.Name
avarCtls(2, i + 1) = ctl.Left
avarCtls(3, i + 1) = ctl.Top
End If
Next ctl
End If


'bubble sort array in left / top order
Do
fChanged = False
For i = 1 To (UBound(avarCtls, 2) - 1) 'don't try this on the
last
control as there will be no i+1 control
If avarCtls(2, i) > avarCtls(2, i + 1) Then
'control(i) is right of control(i+1) - switch the values in
the rows
strName = avarCtls(1, i)
dblLeft = avarCtls(2, i)
dblTop = avarCtls(3, i)
avarCtls(1, i) = avarCtls(1, i + 1)
avarCtls(2, i) = avarCtls(2, i + 1)
avarCtls(3, i) = avarCtls(3, i + 1)
avarCtls(1, i + 1) = strName
avarCtls(2, i + 1) = dblLeft
avarCtls(3, i + 1) = dblTop
'a bubble moved
fChanged = True
ElseIf avarCtls(2, i) = avarCtls(2, i + 1) Then
If avarCtls(3, i) > avarCtls(3, i + 1) Then
'control(i) is lower than control(i+1) - switch the values
in the rows
strName = avarCtls(1, i)
dblLeft = avarCtls(2, i)
dblTop = avarCtls(3, i)
avarCtls(1, i) = avarCtls(1, i + 1)
avarCtls(2, i) = avarCtls(2, i + 1)
avarCtls(3, i) = avarCtls(3, i + 1)
avarCtls(1, i + 1) = strName
avarCtls(2, i + 1) = dblLeft
avarCtls(3, i + 1) = dblTop
'a bubble moved
fChanged = True
End If
End If
Next i
Loop Until fChanged = False


'assign the tab orders
For i = UBound(avarCtls, 2) To 1 Step -1
Debug.Print avarCtls(1, i) & Space(8) & avarCtls(2, i) & Space(8)
&
avarCtls(3, i)
Forms(frmName).Controls(avarCtls(1, i)).TabIndex = i - 1
Next i


End Sub


Function HasProperty(pobj As Object, pstrName As String) As Boolean
'Written by: Christopher Weber @ the DSW Group
'Purpose: returns true if pobj has a property with pstrName name
On Error GoTo ErrorHandler
Dim strProperty As String


strProperty = pobj.Properties(pstrName).Name
HasProperty = True


Exit_Here:
Exit Function


ErrorHandler:
HasProperty = False
Resume Exit_Here


End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top