autoaanvullen bij gegevensvalidatie

[willema]

In een reeks cellen geldt gegevensvalidatie met een lijst.
Is het mogelijk, om wanneer er niet wordt gekozen door te scrollen en te
klikken in de lijstweergave van de cel maar door in de cel te typen, dat de
lijst letter per letter volgt.

Net zoals de lettertypekeuzelijs in Excel werkt.

Groeten,
Marnik

[willema]

Dag allemaal,

Via de site http://www.contextures.com/xlDataVal10.html#Create een methode
gevonden om bovenop een cel met gegevensvalidatie Lijst een combobox te
plaatsen uit de Werkset Besturingselementen om zo meer mogelijkheden met de
lijstweergave te krijgen (zoals autoaanvullen).

Dit is de code:
'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
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 + 5
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

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

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
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
'====================================

Maar er is iets vreemd.

1. Als ik de eigenschappen
MatchEntry op 1 - fmMatchEntryComplete
combineer met
MatchRequired op True
, dan werkt de eerste eigenschap niet meer (autoaanvullen).
En met de tweede eigenschap op False, kan er alles in de cel worden
ingevoerd ook al is de gegevensvalidatie juist ingesteld (Stoppen bij
ongeldige invoer).

2. De rijen zijn zo ingesteld dat de hoogte automatisch wordt aangepast
(AutoAanpassen in het menu Opmaak>Rij). Ook dat werkt dan niet meer.

Wat doe ik verkeerd ?

Groeten,
Marnik