Тема: VBA: Excel обход ограничений UDF
Всем доброго времени суток! Как известно, пользовательсие функции, вызываемые из формул в ячейках листа 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
’ҐЄгй п Є®¤®ў п бва Ёж : 1251