• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Code werkt soms niet

Status
Niet open voor verdere reacties.

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?
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
'====================================
 

Bijlagen

  • Administratie Cees.xlsm
    128,7 KB · Weergaven: 18
Je kan beter een Userform gebruiken voor dit soort zaken.
 
Kijk even na wat je net daarvoor gedaan hebt.
In 1 van je macros zal je de events uitgezet hebben, dus wordt er niet meer gereageerd op een selection_change
Zit je vast, draai dan deze macro en je zou terug vertrokken moeten zijn.
Code:
Sub EventsInschakelen()
   Application.EnableEvents = True
End Sub
 
Bedankt!

Het zit in de code voor het mailen, aan het einde staat daar Application.enableEvents = false

Heb het er nu uit gesloopt.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan