DIREFULKEITH
New Member
- Joined
- May 1, 2019
- Messages
- 1
I combined three forms into a mutli use form and would like help in figuring out how to modify current code to work. I would like to be able to change tab order and shade areas of form I don't need for curtain task based on wihcih command button used on menu page. Here is my current code.( some tab orders have not been chaged to reflect new forms).
module1 code
menu page code (some modicication attempted but doesn't work correctly)
module1 code
Code:
Public Function bIsTabOrderSheet(ByVal wks As Worksheet) As Boolean Dim avSheetList As Variant
avSheetList = Array("FORM", "FORM", "CLASS 1")
bIsTabOrderSheet = _
IsNumeric(Application.Match(wks.Name, avSheetList, 0))
End Function
Public Function GetTabOrder() As Variant
'--set the tab order of input cells - change ranges as required
Select Case ActiveSheet.Name
Case "FORM"
GetTabOrder = Array("E2", "E3", "J3", "E4", "J4", "M4", "K8", "P8", "F9", "K9", _
"P9", "F18", "P18", "F24", "K24", "P24", "F25", "P25", "F27", "P27", _
"F28", "K28", "F31", "K31", "P31", "F32", "K32", "P32", "F33", "K33", "P33", "F34")
Case "FORM"
GetTabOrder = Array("E2", "E3", "J3", "E4", "J4", "M4", "K18", "P8", "F9", "K9", _
"P9", "F11", "K11", "P11", "F12", "K12", "P12", "F13", "K13", "P13", _
"F14", "K14", "P14", "F24", "K24", "P24", "F25", "P25", "F27", "P27", "F28", "K28", _
"F31", "K31", "P31", "F32", "K32", "P32", "F33", "K33", "P33", "F34")
Case "CLASS 1"
GetTabOrder = Array("C2", "H2", "K2", "O2", "B3", "F3", "D6", "H6", "L6", "P6", "C8", "D8", "G8", "H8", "L8", "P8", _
"H10", "H11", "H12", "H13", "H14", "H16", "H17", "H18", "H19", "H20", "H22", "H23", "H24", "H26", _
"B33", "H33", "J33", "P33", "D34", "H34", "L34", "P34", _
"D36", "H36", "L36", "P38", "D37", "H37", "L37", "P37", "D38", "H38", "L38", "P38")
Case Else
MsgBox "Error: Tab Order has not be specified for this sheet."
End Select
End Function
Sub SetOnkey(ByVal state As Boolean)
If state Then
With Application
.OnKey "{TAB}", "'TabRange xlNext'"
.OnKey "~", "'TabRange xlNext'"
.OnKey "{RIGHT}", "'TabRange xlNext'"
.OnKey "{LEFT}", "'TabRange xlPrevious'"
.OnKey "{DOWN}", "'UpOrDownArrow xlDown'"
.OnKey "{UP}", "'UpOrDownArrow xlUp'"
End With
Else
'reset keys
With Application
.OnKey "{TAB}"
.OnKey "~"
.OnKey "{RIGHT}"
.OnKey "{LEFT}"
.OnKey "{DOWN}"
.OnKey "{UP}"
End With
End If
End Sub
Sub TabRange(Optional iDirection As Integer = xlNext)
Dim vTabOrder As Variant
Dim m As Variant
Dim lItems As Long, iAdjust As Long
'--get the tab order from shared function
vTabOrder = GetTabOrder
lItems = UBound(vTabOrder) - LBound(vTabOrder) + 1
On Error Resume Next
m = Application.Match(ActiveCell.Address(0, 0), vTabOrder, False)
On Error GoTo ExitSub
'--if activecell is not in Tab Order return to the first cell
If IsError(m) Then
m = 1
Else
'--get adjustment to index
iAdjust = IIf(iDirection = xlPrevious, -1, 1)
'--calculate new index wrapping around list
m = (m + lItems + iAdjust - 1) Mod lItems + 1
End If
'--select cell adjusting for Option Base 0 or 1
Application.EnableEvents = False
Range(vTabOrder(m + (LBound(vTabOrder) = 0))).Select
ExitSub:
Application.EnableEvents = True
End Sub
Sub UpOrDownArrow(Optional iDirection As Integer = xlUp)
Dim vTabOrder As Variant
Dim lRowClosest As Long, lRowTest As Long
Dim i As Long, iSign As Integer
Dim sActiveCol As String
Dim bFound As Boolean
'--get the tab order from shared function
vTabOrder = GetTabOrder
'--find TabCells in same column as ActiveCell in iDirection
'-- rTest will include ActiveCell
sActiveCol = GetColLtr(ActiveCell.Address(0, 0))
iSign = IIf(iDirection = xlDown, -1, 1)
lRowClosest = IIf(iDirection = xlDown, Rows.Count + 1, 0)
For i = LBound(vTabOrder) To UBound(vTabOrder)
If GetColLtr(CStr(vTabOrder(i))) = sActiveCol Then
lRowTest = Range(CStr(vTabOrder(i))).Row
'--find closest cell to ActiveCell in rTest
If iSign * lRowTest > iSign * lRowClosest And _
iSign * lRowTest < iSign * ActiveCell.Row Then
'--at least one cell in iDirection of same columnn
bFound = True
lRowClosest = lRowTest
End If
End If
Next i
If bFound Then
Application.EnableEvents = False
Cells(lRowClosest, ActiveCell.Column).Select
Application.EnableEvents = True
End If
End Sub
Private Function GetColLtr(sAddr As String) As String
Dim iPos As Long, sTest As String
Do While iPos < 3
iPos = iPos + 1
If IsNumeric(Mid(sAddr, iPos, 1)) Then
Exit Do
Else
sTest = sTest & Mid(sAddr, iPos, 1)
End If
Loop
GetColLtr = sTest
End Function
menu page code (some modicication attempted but doesn't work correctly)
Code:
Private Sub CommandButton1_Click()Sheets("FORM").Visible = xlSheetVisible
Sheets("FORM").Select
End Sub
Private Sub CommandButton2_Click()
Sheets("FORM").Visible = xlSheetVisible
Sheets("FORM").Select
End Sub
Private Sub CommandButton3_Click()
Sheets("CLASS 1").Visible = xlSheetVisible
Sheets("CLASS 1").Select
End Sub
Private Sub CommandButton4_Click()
Sheets("OPC").Visible = xlSheetVisible
Sheets("OPC").Select
End Sub
Private Sub CommandButton5_Click()
Sheets("Swings").Visible = xlSheetVisible
Sheets("Swings").Select
End Sub
Private Sub CommandButton6_Click()
Sheets("Sitdown").Visible = xlSheetVisible
Sheets("Sitdown").Select
End Sub
Private Sub CommandButton7_Click()
Sheets("JLG Registration").Visible = xlSheetVisible
Sheets("JLG Registration").Select
End Sub