Готовый код для проверки условного форматирования не работает - ошибка типа - PullRequest
Новая
       6

Готовый код для проверки условного форматирования не работает - ошибка типа

0 голосов
/ 13 ноября 2018

Я пытаюсь использовать функцию VBA, созданную Бобом Филлипсом , чтобы проверить, выполнено ли условное форматирование в конкретной ячейке. Похоже, что это респектабельное решение, так как Google выдает несколько разных ссылок на него, но выдает ошибку типа для меня. Я использую Excel 2007, и последнее обновление кода было сделано в 2005 году, поэтому я предполагаю, что существуют некоторые проблемы совместимости. Я уже исправил одну синтаксическую ошибку (Set rng = rng(1, 1) не работал, пока я не вставил .Cells), но я не могу ее исправить, потому что не могу разобрать, что делает код.

Функция разработана специально для оценки условных выражений на основе формулы, которой является моя. Вот полный код: 

Public Function IsCFMet2(rng As Range) As Boolean

Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

   Set rng = rng.Cells(1, 1)
   If rng.FormatConditions.Count > 0 Then
      For Each oFC In rng.FormatConditions
         If oFC.Type = xlExpression Then
             're-adjust the formula back to the formula that applies
             'to the cell as relative formulae adjust to the activecell
            With Application
               iRow = rng.Row
               iColumn = rng.Column
               sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
               sF1 = .Substitute(sF1, "COLUMN()", iColumn)
               sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
               sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
            End With
       **** IsCFMet2 = rng.Parent.Evaluate(sF1)
         End If
         If IsCFMet2 Then Exit Function
     Next oFC
   End If

End Function

Ошибка типа выдается звездочкой. Я не совсем понимаю блок With Application или то, как он способствует обнаружению выполненного правила условного форматирования, поэтому я не знаю, в чем проблема или как ее исправить, не нарушая код.

Вот тестовый макрос, который я использую для проверки функции: 

Sub Test():

Dim Tester As Range

Set Tester = ActiveCell

    If IsCFMet2(Tester) Then MsgBox "CF is met!"

End Sub

Тем не менее, я получил ту же ошибку с различными входами диапазона, так что я вполне уверен, что сам вход не является проблемой - я включаю его просто в качестве меры предосторожности.

...