TextBoxes/ComboBoxes by Tab change!

With class programming you can change by "Tab" from a TextBox OR a ComboBox to the next, even if you new TextBoxes or ComboBoxes insert. In this case you must store the file, close and start again, or start the Sub "Private Sub Workbook_Open ()" again. If you "Shift" keep pressed you changed backwards. The TextBoxes or the ComboBoxes are in a worksheet NOT in a UserForm. The files at the end of the article are Excelfiles of the version 2003 and 2007.


The following code belonged In "ThisWorkbook"

Option Explicit
Private objTextBox() As clsTextBox
Private Sub Workbook_Open()
Dim objOLEObject As OLEObject
For Each objOLEObject In Worksheets("Sheet1").OLEObjects 'adapt
If objOLEObject.progID = "Forms.TextBox.1" Then
intIndex = intIndex + 1
Redim Preserve objTextBox(1 To intIndex)
Set objTextBox(intIndex) = New clsTextBox
Set objTextBox(intIndex).mobjTextBox = _
objOLEObject.Object
End If
Next objOLEObject
Sheet1.TextBox1.Activate
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Sheet1" Then ActiveSheet.TextBox1.Activate 'adapt
End Sub

The following code belonged In "Module1"

Option Explicit
Public intIndex As Integer

The following code belonged In a Class Module With name "clsTextBox"

Option Explicit
Public WithEvents mobjTextBox As MSForms.TextBox
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Sub mobjTextBox_KeyDown(ByVal KeyCode As _
MSForms.ReturnInteger, ByVal Shift As Integer)
Dim intTMP As Integer
intTMP = Div_Number(mobjTextBox.Name)
With ThisWorkbook.Worksheets("Sheet1") 'adapt
If intTMP = intIndex Then
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("TextBox" & intTMP - 1).Activate _
Else .TextBox1.Activate
ElseIf intTMP = 1 Then
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("TextBox" & intIndex).Activate _
Else .OLEObjects("TextBox" & intTMP + 1).Activate
Else
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("TextBox" & intTMP - 1).Activate _
Else .OLEObjects("TextBox" & intTMP + 1).Activate
End If
End With
End Sub
Private Function Div_Number(strTMP As String) As Integer
Dim intTMP As Integer
Dim strText As String
For intTMP = 1 To Len(strTMP)
If IsNumeric(Mid(strTMP, intTMP, 1)) Then
strText = strText & Mid(strTMP, intTMP, 1)
End If
Next intTMP
Div_Number = strText * 1
End Function

The following code Is For Comboboxes

The following code belonged In "ThisWorkbook"

Option Explicit
Private objCombo() As clsCombo
Private Sub Workbook_Open()
Dim objOLEObject As OLEObject
For Each objOLEObject In Worksheets("Sheet1").OLEObjects 'adapt
If objOLEObject.progID = "Forms.ComboBox.1" Then
intIndex = intIndex + 1
Redim Preserve objCombo(1 To intIndex)
Set objCombo(intIndex) = New clsCombo
Set objCombo(intIndex).mobjCombo = objOLEObject.Object
End If
Next objOLEObject
Sheet1.ComboBox1.Activate
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Sheet1" Then ActiveSheet.ComboBox1.Activate 'adapt
End Sub

The following code belonged In "Module1"

Option Explicit
Public intIndex As Integer

The following code belonged In a Class Module With name "clsCombo"

Option Explicit
Public WithEvents mobjCombo As MSForms.ComboBox
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Sub mobjCombo_KeyDown(ByVal KeyCode As _
MSForms.ReturnInteger, ByVal Shift As Integer)
Dim intTMP As Integer
intTMP = Div_Number(mobjCombo.Name)
With ThisWorkbook.Worksheets("Sheet1") 'adapt
If intTMP = intIndex Then
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("ComboBox" & intTMP - 1).Activate _
Else .ComboBox1.Activate
ElseIf intTMP = 1 Then
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("ComboBox" & intIndex).Activate _
Else .OLEObjects("ComboBox" & intTMP + 1).Activate
Else
If KeyCode = 9 Then If GetAsyncKeyState(16) Then _
.OLEObjects("ComboBox" & intTMP - 1).Activate _
Else .OLEObjects("ComboBox" & intTMP + 1).Activate
End If
End With
End Sub
Private Function Div_Number(strTMP As String) As Integer
Dim intTMP As Integer
Dim strText As String
For intTMP = 1 To Len(strTMP)
If IsNumeric(Mid(strTMP, intTMP, 1)) Then
strText = strText & Mid(strTMP, intTMP, 1)
End If
Next intTMP
Div_Number = strText * 1
End Function

Sample for Textboxes


Sample 2003

Sample 2007


Sample for Comboboxes


Sample 2003

Sample 2007

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...