我尝试根据另一张纸上某些区域的内容创建一些下拉列表,并向所涉及的单元格添加条件格式。
在保存文件并重新打开文件后,代码正常工作,但下拉列表消失了! 为什么以及如何避免这种情况(我想将定义保留在另一个工作表上)?
我可以提供一个示例文件(但是如何?)
我没有在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