VBA: Excel обход ограничений UDF

null@example.com (omegastripes) — Wed, 23 Apr 2014 01:31:29 +0000

Всем доброго времени суток! Как известно, пользовательсие функции, вызываемые из формул в ячейках листа Excel (UDF), не могут никоим образом изменять среду приложения. А при попытке модификации - функция просто прерывается и возвращает #ЗНАЧ!. Хочу предложить вашему вниманию метод обхода данного ограничения. Метод основан на отложенном выполнении целевых функций по событию Workbook_SheetCalculate, в то время как вызов UDF лишь заносит необходимые данные в список отложенных. Данный метод позволит, например, изменять формат ячейки c UDF, или содержимое соседних ячеек, листов, или даже любых доступных данных приложения, не переступая ограничения UDF. Я рассмотрю его реализацию на примере задачи, в которой UDF принимает в качестве аргументов название листа и путь к закрытой книге, и возвращает первую использующуюся строку на этом листе.

Данный код разместить в одном из модулей VBAProject:


Public Tasks, Permit, Transfer

Function GetFirstRowSched(FileName, SheetName) ' UDF откладывает занесение значения в ячейку до выполнения всех UDF
    If IsEmpty(Tasks) Then TasksInit
    If Permit Then Tasks.Add Application.Caller, Array(FileName, SheetName) ' упаковывает аргументы в массив, ключом словаря является сам объект ячейки UDF
    GetFirstRowSched = Transfer
End Function

Sub TasksInit() ' задаются начальные параметры
    Set Tasks = CreateObject("Scripting.Dictionary")
    Transfer = ""
    Permit = True
End Sub

Function GetFirstRowConv(FileName, SheetName) ' функция работает без ограничений UDF, как обычные процедуры, фактически, расчеты выполняются в данной функции
    With Application.Workbooks.Open(FileName)
        GetFirstRowConv = .Sheets(SheetName).UsedRange.Row
        .Close
    End With
End Function

Данный код разместить в разделе VBAProject - Microsoft Excel Objects - ThisWorkbook:


Private Sub Workbook_SheetCalculate(ByVal Sh As Object) ' событие пересчета листа, выполняющее все отложенные вызовы, и помещающее значения в ячейки с UDF
    Dim Task, TempFormula
    If IsEmpty(Tasks) Then TasksInit
    Application.EnableEvents = False
    Permit = False
    For Each Task In Tasks ' цикл по объектам всех вызванных ячеек с UDF
        TempFormula = Task.FormulaR1C1
        Transfer = GetFirstRowConv(Tasks(Task)(0), Tasks(Task)(1)) ' распаковывает аргументы из массива для выполнения вычислений
        Task.FormulaR1C1 = TempFormula ' после данной строки повторно вызывается UDF ячейки Task, и в качестве результата в ячейку возвращается Transfer
        Tasks.Remove Task
    Next
    Application.EnableEvents = True
    Transfer = ""
    Permit = True
End Sub

Впрочем, для решения конкретно данной задачи, было достаточно составить следующую UDF, использующую позднее связывание, без применения столь витиеватого вышеописанного метода:


Function GetFirstRowLbind(FileName, SheetName)
    On Error Resume Next
    With CreateObject("Excel.Application")
        .Workbooks.Open (FileName)
        GetFirstRowLbind = .Sheets(SheetName).UsedRange.Row
        .Quit
    End With
End Function

Серый форум — VBA: Excel обход ограничений UDF

VBA: Excel обход ограничений UDF