Sklic na funkcijo

[Stenly]

Pozdravljeni

Želel bi sklic na funkcijo (VBA) iz WB1 na WB2. Je to možno (kako).

Lp

[admin]

Z ukazom Application.Run. Primer:

Koda: Izberi vse

Application.Run "drugi_zvezek.xls!ime_makra_v_drugem_zvezku"

[Stenly]

Najprej hvala za hitri odgovor

Se pa nisem dobro izrazil.
Npr. v WB1 imam f:

Koda: Izberi vse

Function Dir_BP()
'
   Dir_BP = CStr(Workbooks("Zagon.XLS").Worksheets("List2").Range("E7"))
  
End Function

Sedaj pa bi se rad iz WB2,... skliceval na to f iz WB1; npr.:

Koda: Izberi vse

MsgBox Dir_BP

Imam namreč hkrati odprtih več WB-ov, pa v vseh ne bi rad ponavljal določenih stavkov, pač pa bi se skliceval na WB, ki je stalno odprt.

Lp

[admin]

No potem pa dajmo malce daljše .. Spodaj vam prilagam kodo, ki jo je napisal Ken Puls in jo dajem dalje v originalu

Koda: Izberi vse

Option Explicit 
 
Sub RunMacro_NoArgs() 
     'Macro purpose:  Use the application.run method to execute
     'a macro without arguments from another workbook
     
    Dim PathToFile As String, _ 
    NameOfFile As String, _ 
    wbTarget As Workbook, _ 
    CloseIt As Boolean 
     
     'Set file name and location. You will need to update this info!
    NameOfFile = "MyMacroLivesHere.xls" 
    PathToFile = "C:\temp" 
     
     'Attempt to set the target workbook to a variable.  If an error is
     'generated, then the workbook is not open, so open it
    On Error Resume Next 
    Set wbTarget = Workbooks(NameOfFile) 
     
    If Err.Number <> 0 Then 
         'Open the workbook
        Err.Clear 
        Set wbTarget = Workbooks.Open(PathToFile & "\" & NameOfFile) 
        CloseIt = True 
    End If 
     
     'Check and make sure workbook was opened
    If Err.Number = 1004 Then 
        MsgBox "Sorry, but the file you specified does not exist!" _ 
        & vbNewLine & PathToFile & "\" & NameOfFile 
        Exit Sub 
    End If 
    On Error Goto 0 
     
     'Run the macro!  (You will need to update "MacroName" to the
     'name of the macro you wish to run)
    Application.Run (wbTarget.Name & "!MacroName") 
     
    If CloseIt = True Then 
         'If the target workbook was opened by the macro, close it
        wbTarget.Close savechanges:=False 
    Else 
         'If the target workbook was already open, reactivate this workbook
        ThisWorkbook.Activate 
    End If 
     
End Sub 
 
Sub RunMacro_WithArgs() 
     'Macro purpose:  To use the application.run method to execute
     'a function or macro (with arguments) from another workbook
     
    Dim PathToFile As String, _ 
    NameOfFile As String, _ 
    wbTarget As Workbook, _ 
    MyResult As Variant, _ 
    CloseIt As Boolean 
     
     'Set file name and location. You will need to update this info!
    NameOfFile = "MyFunctionLivesHere.xls" 
    PathToFile = "C:\temp" 
     
     'Attempt to set the target workbook to a variable.  If an error is
     'generated, then the workbook is not open, so open it
    On Error Resume Next 
    Set wbTarget = Workbooks(NameOfFile) 
     
    If Err.Number <> 0 Then 
         'Open the workbook
        Err.Clear 
        Set wbTarget = Workbooks.Open(PathToFile & "\" & NameOfFile) 
        CloseIt = True 
    End If 
     
     'Check and make sure workbook was opened
    If Err.Number = 1004 Then 
        MsgBox "Sorry, but the file you specified does not exist!" _ 
        & vbNewLine & PathToFile & "\" & NameOfFile 
        Exit Sub 
    End If 
     
    On Error Goto 0 
     
     'Run the function.  Update the "FunctionName" to the name of your function
     'and change 1 & 2 to the arguments you need to pass to the function
    MyResult = Application.Run(wbTarget.Name & "!Functionname", 1, 2) 
     
     'Give user the results
    MsgBox MyResult 
     
    If CloseIt = True Then 
         'If the target workbook was opened by the macro, close it
        wbTarget.Close savechanges:=False 
    Else 
         'If the target workbook was already open, reactivate this workbook
        ThisWorkbook.Activate 
    End If 
     
End Sub 

[Stenly]

; je pa bol zapleteno, kot sem pa pričakoval.
Se pa zahvaljujem za trud.

Lp