PDA

View Full Version : Tab Order



blackbird
01-30-2009, 07:51 PM
I have a worksheet that I'd like to enforce a tab order based on a true / false value in a linked cell, basically I have cells that are shaded with conditional formatting. The user can skip these cells and go to the next unshaded cell in the tab order, but since cells keep changing based on user input and formulas the tab order changes each time the worksheet is used.

I found code by Anne Troy here:
vbaexpress.com/kb/getarticle.php?kb_id=209
(I wasn't "allowed" to link to the code)

This code isn't quite what I really need... its a good start though.

I would settle for just going from cell B4 to B21 to B5 and then being done with the loop.. but I can't figure out to keep the code from looping around.

Any help (stopping the looping first) is greatly appreciated.
:)

Oorang
02-03-2009, 02:26 PM
I slapped this together in a hurry, see if it's what you want:


Option Explicit
Private Type Coordinates
X As Long
Y As Long
End Type
Private Type TabList
Worksheet As Excel.Worksheet
Ranges() As String
Coordinates() As Coordinates
NoLoop As Boolean
UpperBound As Long
End Type
Private m_tTabStops As TabList
Private m_lngTabIndx As Long
Private Sub Workbook_Open()
m_tTabStops = LoadTabList("Sheet1", "A1 B2 B3", True)
Excel.Application.OnKey "{TAB}", "ThisWorkbook.CustomTabOrder"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Excel.Application.OnKey "{TAB}"
End Sub
Private Sub CustomTabOrder()
If Excel.ActiveSheet Is m_tTabStops.Worksheet Then
If m_tTabStops.Ranges(m_lngTabIndx) = ActiveCell.Address(False, False) Then
m_lngTabIndx = m_lngTabIndx + 1
If m_lngTabIndx > m_tTabStops.UpperBound Then
If m_tTabStops.NoLoop Then
Excel.Application.OnKey "{TAB}"
End If
m_lngTabIndx = 0
End If
Else
m_lngTabIndx = GetClosestRange(ActiveCell, m_tTabStops)
End If
m_tTabStops.Worksheet.Range(m_tTabStops.Ranges(m_lngTabIndx)).Select
Else
ActiveCell.Offset(0, 1).Select
End If
End Sub
Private Function GetClosestRange(distanceFrom As Excel.Range, tabStops As TabList) As Long
Dim lngRtnVal As Long
Dim lngIndx As Long
Dim lngDFX As Long
Dim lngDFY As Long
Dim dblMin As Double
Dim dblDstnc As Double
dblMin = 2 ^ 64
lngDFX = distanceFrom.Row
lngDFY = distanceFrom.Column
For lngIndx = 0 To tabStops.UpperBound
dblDstnc = Math.Sqr((Abs(tabStops.Coordinates(lngIndx).X - lngDFX) ^ 2) + (Abs(tabStops.Coordinates(lngIndx).Y - lngDFY) ^ 2))
If dblDstnc < dblMin Then
dblMin = dblDstnc
lngRtnVal = lngIndx
End If
Next
GetClosestRange = lngRtnVal
End Function
Private Function LoadTabList(ByVal wsCodeName As String, _
ByRef tabStops As String, _
Optional ByVal tabNoLoop As Boolean = False) As TabList
Dim tRtnVal As TabList
Dim ws As Excel.Worksheet
wsCodeName = LCase$(wsCodeName)
For Each ws In Excel.ThisWorkbook.Worksheets
If LCase$(ws.CodeName) = wsCodeName Then
Exit For
End If
Next
With tRtnVal
Set .Worksheet = ws
.Ranges = Split(UCase$(Replace(tabStops, "$", vbNullString, Compare:=vbBinaryCompare)))
.UpperBound = UBound(.Ranges)
.NoLoop = tabNoLoop
.Coordinates = LoadCoordinates(.Worksheet, .Ranges)
End With
LoadTabList = tRtnVal
End Function
Private Function LoadCoordinates(ByVal ws As Excel.Worksheet, tabRanges() As String) As Coordinates()
Dim tRtnVal() As Coordinates
Dim lngUB As Long
Dim lngIndx As Long
lngUB = UBound(tabRanges)
ReDim tRtnVal(lngUB) As Coordinates
For lngIndx = 0 To lngUB
With ws.Range(tabRanges(lngIndx))
tRtnVal(lngIndx).X = .Row
tRtnVal(lngIndx).Y = .Column
End With
Next
LoadCoordinates = tRtnVal
End Function