Ser til at den kan løses.. men det er en langhåret en...
Man skal lave nogle public variabler (min løsning), finde den aktive celle og så bruge timer metoden, da en UDF ikke "normalt" kan ændre andet end vise en værdi...
syntax i excel = Personal.xlsb!GetValue("c:\temp\";"Book1.xlsm";"Sheet1";"b1")
så sættes formlen ind
=Index('c:\temp\[book1.xlsm]sheet1'!B1)
og værdien kommer selvom arket er lukket :)
VBA koden:
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 Path As String
Public Filename As String
Public sSheet As String
Public sCell As String
Public AktivCelle As String
Public Function GetValue(aPath As String, aFilename As String, aSheet As String, aCell As String)
'Guldkort fundet her:
https://stackoverflow.com/questions/9476282/cannot-vba-write-data-to-cells-in-excel-2007-2010-within-a-function'Gemmer vores variabler i formlen i de public variabler
if right(aPath) <>"\" then
aPath = aPath & "\"
end if
Path = aPath
Filename = aFilename
sSheet = aSheet
sCell = aCell
AktivCelle = ActiveCell.Address
' 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.
GetValue = "Er igang"
' 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
Range(AktivCelle).FormulaLocal = "=index('" & Path & "[" & Filename & "]" & sSheet & "'!" & sCell & ";1;1)" Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
