Samsung6713
Gebruiker
- Lid geworden
- 24 dec 2019
- Berichten
- 209
Goedeavond,
Ik heb onderstaande code om gegevensvalidatie te combineren met een keuzelijst met invoervak.
Deze werkt goed, maar soms doet de code het niet, de gegevens worden dan niet opgehaald uit de cel waarop de combobox dan staat.
Het lukt me niet om te achterhalen waardoor de code het niet doet.
Als ik opnieuw opstart werkt de code wel weer.
Wie weet hoe ik de fout kan achterhalen?
Ik heb onderstaande code om gegevensvalidatie te combineren met een keuzelijst met invoervak.
Deze werkt goed, maar soms doet de code het niet, de gegevens worden dan niet opgehaald uit de cel waarop de combobox dan staat.
Het lukt me niet om te achterhalen waardoor de code het niet doet.
Als ik opnieuw opstart werkt de code wel weer.
Wie weet hoe ik de fout kan achterhalen?
Code:
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
On Error GoTo errHandler
If Target.Count > 1 Then GoTo exitHandler
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
Resume exitHandler
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, change to KeyUp
'Table with numbers for other keys such as Right Arrow (39)
'https://msdn.microsoft.com/en-us/library/aa243025%28v=vs.60%29.aspx
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
'====================================