Gruppe
Dialog
Problem
Wenn der Cursor in Zeile 5 gesetzt wird, soll eine UserForm mit den Einträgen am Ende der Zeile und der Möglichkeit einer freien Texteingabe angezeigt werden.
ClassModule: Tabelle1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iCol As Integer
Application.EnableEvents = False
If Selection.Cells.Count > 1 Then GoTo ERRORHANDLER
On Error Resume Next
iCol = Range("IV5").CurrentRegion.Column - 1
If Not Intersect(Target, Range(Cells(5, 1), Cells(5, iCol))) Is Nothing Then
frmOptions.Show
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub
ClassModule: frmOptions
Dim bFlag As Boolean
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim iRow As Integer
If txtOption.Value = "" Then
For iRow = 0 To lstOptions.ListCount - 1
If lstOptions.Selected(iRow) Then
ActiveCell.Value = lstOptions.List(iRow)
Exit For
End If
Next iRow
Else
ActiveCell.Value = txtOption.Text
End If
Unload Me
End Sub
Private Sub lstOptions_Change()
If bFlag = True Then Exit Sub
txtOption.Text = ""
End Sub
Private Sub txtOption_Change()
Dim iRow As Integer
If txtOption.Value = "" Or txtOption.TextLength > 1 Then Exit Sub
bFlag = True
For iRow = 0 To lstOptions.ListCount - 1
lstOptions.Selected(iRow) = False
Next iRow
End Sub
Private Sub txtOption_Exit(ByVal Cancel As MSForms.ReturnBoolean)
bFlag = False
End Sub
Private Sub UserForm_Initialize()
Dim iCounter As Integer, iStart As Integer
iStart = Range("IV5").CurrentRegion.Column
For iCounter = iStart To 256
lstOptions.AddItem Cells(5, iCounter).Value
Next iCounter
End Sub