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
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