保存并重新打开后，溺水名单消失

Question

我尝试根据另一张纸上某些区域的内容创建一些下拉列表，并向所涉及的单元格添加条件格式。

在保存文件并重新打开文件后，代码正常工作，但下拉列表消失了！ 为什么以及如何避免这种情况（我想将定义保留在另一个工作表上）？

我可以提供一个示例文件（但是如何？）

我没有在worksheet_open（）上运行任何代码。

Sub InitiateCriteria()
' Add conditional formatting to Range(Evenementen_Overzicht) based on Criteria provided on sheet(Instellingen)

    Dim nameEvenementen: nameEvenementen = "Evenementen_Overzicht"          ' Naam range met de Evenementen
    Dim prefixNameCriteria: prefixNameCriteria = "Criteria_"                ' Prefix van elke range die een Criteria is
    Dim prefixNameEvenementen: prefixNameEvenementen = "Evenementen_"       ' Prefix van elke range in Evenementen_Overzicht die op basis van Criteria_ wordt verwerkt
    Dim nameCriteria As String
    Dim nameEvenement As String

    Dim arrNameRanges: arrNameRanges = Array("Evaluatie_Oordeel", "Bezoekers_Waardering")
    Dim element As Variant
    For Each element In arrNameRanges
        nameCriteria = prefixNameCriteria & element
        Dim rngCriteria As Range
        Set rngCriteria = Range(nameCriteria)
        nameEvenement = prefixNameEvenementen & element
        Dim rngEvenement As Range
        Set rngEvenement = Range(nameEvenement)
        rngEvenement.FormatConditions.Delete
        Dim inList As Boolean
        Dim kleur As Long
        Dim waarde As String
        Dim keuzes As String
        With rngCriteria
            Dim numRows: numRows = .Rows.Count
            Dim i As Integer
            inList = False
            For i = 1 To numRows
                If (UCase(.Cells(i, 3)) = "JA") Then
                ' Dit criteria staat in de dropdown list --> formuleer een conditie
                    With .Cells(i, 2)
                        kleur = .Interior.Color
                        With rngEvenement.FormatConditions.Add(xlCellValue, xlEqual, .Value2)
                            .StopIfTrue = True
                            .Interior.Color = kleur
                        End With
                    End With
                    If (inList = False) Then
                        With rngEvenement.Validation
                        ' Hernieuw de dropdown list
                            .Delete
                            keuzes = Range(rngCriteria.Cells(1, 2), rngCriteria.Cells(numRows, 2)).Address(True, True, xlA1, True)
                            keuzes = "=" & Right(keuzes, Len(keuzes) - InStr(keuzes, "]"))
                            .Add xlValidateList, xlValidAlertStop, xlBetween, keuzes
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .ShowInput = False
                        End With
                        inList = True
                    End If
                End If
            Next i
        End With
    Next element
End Sub