Я не хочу, чтобы моя надстройка Excel возвращала массив (вместо этого мне нужен UDF для изменения других ячеек)

Я создал надстройку Excel, и одна из функций этого надстройки, скажем, New_Years в настоящее время занимает 2 года и выводит каждый день Нового года между этими двумя годами в виде массива в Excel. Так New_Years(2000,2002) вернется 1 января 2000 года, 1 января 2001 года и 1 января 2002 года в последнюю камеру.

Проблема в том, что я должен знать, что за это время будет 3 даты, выбрать 3 ячейки, ввести мою формулу в верхнюю ячейку и затем нажать Ctrl + Shift + Enter заполнить массив.

Я использую XLW версии 5 для преобразования своего кода C++ в файл.xll. Мне бы очень понравилось, если бы был какой-то способ, которым я мог бы просто заполнить один квадрат своей формулой, а Excel заполнил бы квадраты ниже по мере необходимости с соответствующими датами. Кто-нибудь знает, возможно ли это? Или невозможно?

Большое спасибо!

Источник

1 ответ

Решение

На самом деле это возможно, хотя и сложно. Я репостирую этот кусок магии от Кевина Джонса, он же Zorvek, так как он находится за EE Paywall (ссылка прикреплена, если у кого-то есть доступ)

В то время как Excel строго запрещает UDF изменять любые свойства ячейки, листа или рабочей книги, существует способ осуществить такие изменения, когда UDF вызывается с использованием таймера Windows и таймера Application.OnTime по очереди. Таймер Windows должен использоваться в UDF, потому что Excel игнорирует любые вызовы Application.OnTime внутри UDF. Но, поскольку таймер Windows имеет ограничения (Excel мгновенно завершит работу, если таймер Windows попытается запустить код VBA, если ячейка редактируется или открыто диалоговое окно), он используется только для планирования таймера Application.OnTime, безопасного таймера. какой Excel только позволяет быть запущенным, если ячейка не редактируется и никакие диалоги не открыты.

Приведенный ниже пример кода демонстрирует, как запустить таймер Windows из UDF, как использовать эту процедуру таймера для запуска таймера Application.OnTime и как передать информацию, известную только UDF, в последующие процедуры, выполняемые таймером. Код ниже должен быть помещен в обычный модуль.

Private Declare Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long _
   ) As Long

Private Declare Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date

Public Function AddTwoNumbers( _
      ByVal Value1 As Double, _
      ByVal Value2 As Double _
   ) As Double

' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.

   AddTwoNumbers = Value1 + Value2

   ' Cache the caller's reference so it can be dealt with in a non-UDF routine
   If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
   On Error Resume Next
   mCalculatedCells.Add Application.Caller, Application.Caller.Address
   On Error GoTo 0

   ' Setting/resetting the timer should be the last action taken in the UDF
   If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
   mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

End Function

Public Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

   ' Stop the Windows timer
   On Error Resume Next
   KillTimer 0&, mWindowsTimerID
   On Error GoTo 0
   mWindowsTimerID = 0

   ' Cancel any previous OnTime timers
   If mApplicationTimerTime <> 0 Then
      On Error Resume Next
      Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
      On Error GoTo 0
   End If

   ' Schedule timer
   mApplicationTimerTime = Now
   Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"

End Sub

Public Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

   Dim Cell As Range

   ' Do tasks not allowed in a UDF...
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Do While mCalculatedCells.Count > 0
      Set Cell = mCalculatedCells(1)
      mCalculatedCells.Remove 1
      Cell.Offset(0, 1).Value = Cell.Value
   Loop
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   End Sub
Источник

Благодаря более раннему сообщению на этой странице я смог создать своего рода простой в использовании модуль.



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' POST UDF UPDATING MODULE              v.9.2020 cdf
'
' Since Excel won't allow UDFs to update any other cells,
'   an API timer is used to trigger a post UDF subroutine.
'
' Before the tweak, the code was found here:
'   https://stackru.com/questions/8520732/
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HOW TO USE
'
' All the code is in the UDF module.
'
' Top of the module (under Option Explicit statement):
'   ' rngUDFcell references the orignally modified UDF cell.
'   ' Set in the UDF routine and used in post UDF routine.
'   Dim rngUDFcell As Range
'
' UDF routine (At the end (should be at the end) of your UDF code):
'   Set rngUDFcell = ActiveCell
'   Call ThisModulesName.SetAPITimer("YourModule.YourPostUDFRoutine")
'
'   'Note: Change ThisModulesName     to this module's name,
'   '             YourModule          to the module your UDF is in,
'   '             YourPostUDFRoutine  to your post UDF subroutine.
'   '
'   '      Example: Module4.SetAPITimer("Module1.UpdateMyCells")
'
' Post UDF routine:
'   ' Since mouse clicks and the {Enter}, {Tab} and {Delete} keys all act
'   ' differently, the active cell could be anywhere. The rngAC range
'   ' is added to help return to it after the cell updating is done.
'   '
'   ' The rngUDFcell range is used for cell updating.
'   ' It references the originally modified UDF cell.
'
'   Dim rngAC As Range              'top of routine
'   Set rngAC = ActiveCell
'
'   lRow = rngUDFcell.Row           'cell updating
'   lCol = rngUDFcell.Column
'   ...
'
'   Range(rngAC.Address).Select     'bottom of routine
'

#If VBA7 Then

Private Declare PtrSafe Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As LongLong _
   ) As Long

Private Declare PtrSafe Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long
   
#Else

Private Declare Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long _
   ) As Long

Private Declare Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long
   
#End If

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date
Private mRoutine As String

Public Sub SetAPITimer(sRoutine As String)
    
' Starts a windows timer that starts a second Appliction.OnTime
' timer that performs activities not allowed in a UDF. Do
' not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile
' formulas/functions or uncontrolled looping will start.

    ' Cache the caller's reference so it can be dealt with in a non-UDF routine
    If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
    On Error Resume Next
    mCalculatedCells.Add Application.Caller, Application.Caller.Address
    On Error GoTo 0

    ' Setting/resetting the timer should be the last action taken in the UDF
    If mWindowsTimerID  0 Then KillTimer 0&, mWindowsTimerID
    mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

    ' Set Post UDF module and routine
    mRoutine = sRoutine
End Sub

Private Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

   ' Stop the Windows timer
   On Error Resume Next
   KillTimer 0&, mWindowsTimerID
   On Error GoTo 0
   mWindowsTimerID = 0

   ' Cancel any previous OnTime timers
   If mApplicationTimerTime  0 Then
      On Error Resume Next
      Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
      On Error GoTo 0
   End If

   ' Schedule timer
   mApplicationTimerTime = Now
   Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"
End Sub

Private Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

    ' Do tasks not allowed in a UDF... (post UDF code)
    Application.Run mRoutine
End Sub
Источник
Другие вопросы по тегам