Vba-functie werkt niet als formule.

[MDN111]

Hallo !

Bij een poging om iemand te helpen ben ik op iets gestuit waar ik niet mee weg kan.

Het gaat over het volgende: we hebben een workbook, met 1 sheet, en in de cel A1 staat een bestandsnaam. Het is de bedoeling dat in de cel A2 de waarde komt te staan uit de cel X1 van de sheet van het workbook waarvan de naam in A1 vermeld staat. De bestandsnaam in A1 is afhankelijk van de gebruikersinvoer en kan dus wijzigen. Bijvoorbeeld: als in A1 de bestandsnaam "maart.xls" staat, dan zou in A2 de waarde van X1 van de (enige) sheet van maart.xls moeten komen.

Dat lijkt niets spectaculairs en de volgende functie geeft die waarde:

Function GetValueFromOtherWorkbook(ByVal cFile As String) As Variant
Dim oWB As Workbook
On Error Resume Next
Set oWB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & cFile, ReadOnly:=True)
On Error GoTo 0
If Not oWB Is Nothing Then
    With oWB
        GetValueFromOtherWorkbook = .Sheets(1).Range("X1").Value
        .Close
    End With
End If
End Function

Als we die functie aanroepen vanuit een "gewone' Sub, dan werkt die zoals verwacht:

Sub test()
With ThisWorkbook.Sheets(1).Cells(1, 1)
    .Offset(0, 1).Value = GetValueFromOtherWorkbook(.Value)
End With
End Sub

Ook als we ze aanroepen vanuit een event-procedure werkt ze zoals verwacht:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
    Target.Offset(0, 1).Value = GetValueFromOtherWorkbook(Target.Value)
End If
End Sub

Maar als we ze gebruiken als formule in de worksheet zelf, dan werkt het plotseling niet meer. Zie screenshot.



Het argument naar de functie wordt blijkbaar correct doorgegeven, maar na de regel "Set oWB = Workbooks.Open ..." blijft de waarde van oWB op Nothing (???). Op geen enkel moment volgt er een foutmelding.

Opzoekingen op het www hebben tot hiertoe niets opgeleverd. Iemand een idee over de reden waarom dat niet werkt?

Grtz,
MDN111.

 

[edmoor]

Staat de functie in een module? Heb je hem al eens in Debug mode met F8 door gelopen? Heb je de On Error Resume Next al eens weg gelaten?

 

[MDN111]

Dag Edmoor !

Ja, allemaal getest.

• De functie staat in een module, anders zouden we een #NAME? krijgen.
• Met F8 stap voor stap doorlopen. Het is zo dat ik te weten kwam dat oWB op Nothing blijft staan.
• Ook getest met On Error Resume Next weggelaten.

In dat laatste geval gebeurt er ook iets bizars. Neem de situatie dat we On Error Resume Next weglaten en de gebruiker voert een onbestaande bestandsnaam in als waarde in cel A1. In geval van een aanroep vanuit een andere Sub en in geval van een aanroep vanuit de event-procedure geeft dat aanleiding tot een 1004-error, wat normaal is. Maar in geval we de functie als worksheet-formule gebruiken ontstaat er zelfs geen foutboodschap, wat helemaal niet normaal is (???).

Hierbij nog even de bestanden in kwestie. Ik werk met Excel 2003.

Grtz,
MDN111.

 

[HSV]

Test het zo eens.

Function GetValueFromOtherWorkbook(cFile As String) As Variant
 With GetObject(ThisWorkbook.Path & "\" & cFile)
   GetValueFromOtherWorkbook = .Sheets(1).Range("X1").Value
   .Close
 End With
End Function

Sub test()
  With ThisWorkbook.Sheets(1).Cells(1, 1)
    .Offset(0, 1).Value = GetValueFromOtherWorkbook(.Value)
  End With
End Sub

 

[MDN111]

Gevonden.

Dag Edmoor !
Dag HSV !

Heb juist iets gelijkaardigs gevonden. Het heeft te maken met het feit dat Excel een User Defined Function als formule berekent en daarbij binnen dezelfde instance geen ander bestand kan openen. De oplossing ligt in het openen van het bestand in een andere instance van Excel, zoals in onderstaande code:

Function GetValueFromOtherWorkbook(ByVal cFile As String) As Variant
Dim oWB As Workbook
[COLOR="#FF0000"]Dim oXLApp As Object[/COLOR]
[COLOR="#FF0000"]Set oXLApp = CreateObject("Excel.Application")[/COLOR]
oXLApp.Visible = False
On Error Resume Next
Set oWB =[COLOR="#FF0000"] oXLApp[/COLOR].Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & cFile, ReadOnly:=True)
On Error GoTo 0
If Not oWB Is Nothing Then
    With oWB
        GetValueFromOtherWorkbook = .Sheets(1).Range("X1").Value
        .Close
    End With
End If
End Function

Sorry HSV, ik heb ook jou code getest, maar die draaide alles in de war. Zie screenshot.



Zou het kunnen dat Getobject() een referentie creëert naar dezelfde Excel-instance die al draaiende is?

Grtz,
MDN111.

 

[HSV]

Geen idee: werkt hier voor beiden (zowel de sub aanroepen als de UDF in een cel).

 

[edmoor]

Die van HSV werkt hier ook prima.

 

[HSV]

Dank voor het testen en de overtuiging edmoor.

 

[MDN111]

Dag HSV !

Ook zonder Edmoor's test geloof ik jou op je woord. :thumb:

Ik heb het nog eens getest. Computer herstart (koud), Excel opnieuw gestart, nieuw maagdelijk bestand geopend, module toegevoegd en UDF er in. Resultaat hetzelfde. Niets aan te doen.

Misschien speelt hier wel het verschil in versie een rol. Windows 7 met Office 2003 tegenover ... ?

En wie weet, misschien werkt m'n eerste code uit #1 ook wél bij jullie?

Grtz,
MDN111.

 

[edmoor]

Je eerste code levert bij mij hetzelfde probleem als je beschrijft.

 

[MDN111]

Na nog wat "gegoogel" ben ik uiteindelijk op dit gestoten, waar in vermeld staat:

A user-defined function called by a formula in a worksheet cell cannot change the environment of Microsoft Excel. This means that such a function cannot do any of the following:

• Insert, delete, or format cells on the spreadsheet.
• Change another cell's value.
• Move, rename, delete, or add sheets to a workbook.
• Change any of the environment options, such as calculation mode or screen views.
• Add names to a workbook.
• Set properties or execute most methods.

Ik ga het hierbij laten en de status op "opgelost" zetten.
Bedankt voor de reacties.

Grtz,
MDN111.

 

[snb]

GetObject maakt gebruik van een bestaande 'instantie' van Excel. Als die er niet is, wordt die instantie gemaakt.

Mij lijkt dat je code ook zo kan:

Function F_snb(c00)
  with CreateObject("Excel.Application")
     F_snb =.Workbooks.Open(c00).Sheets(1).Range("A1").Value
     .quit
   end with
End Function

of ook:

Function F_snb(c00)
  With GetObject(c00)
    F_snb = .Sheets(1).Range("A1").Value
    .Close 0
  End With
End Function

 

[MDN111]

Dag snb !

Beide functies werken als ze worden aangeroepen vanuit een macro.
Beide functies werken niet als UDF in een cel. Foutmelding: #VALUE!

Grtz,
MDN111.

 

[HSV]

Dag HSV !

Misschien speelt hier wel het verschil in versie een rol. Windows 7 met Office 2003 tegenover ... ?

En wie weet, misschien werkt m'n eerste code uit #1 ook wél bij jullie?

Grtz,
MDN111.

Dag MDN111,

Ik heb Win7 en Excel 2007 en 2003.'
In beide versies werkt het feilloos.

Nee, de code van #1 werkt niet als formule in een cel hier.

 

[snb]

Je hebt voor c00 toch wel de volledige naam (pad & naam) ingevoerd ?.

Hier werken beide codes vlekkelings (Excel 2010, XP)

 

[MDN111]

Dag snb !

In eerste instantie verwachtte ik dat de functie wel zou werken als formule met CreateObject (wegens openen in nieuwe instance) en dat ze niet zou werken met GetObject (wegens openen in dezelfde instance). Het verbaasde mij dat ze geen van beiden werkten, maar dat was helaas mijn eigen fout. Zoals snb aangeeft was ik de volledige path vergeten te vermelden in A1. Mijn excuses daarvoor.

Met volledige path in A1 en de functie als formule krijgen we het volgende resultaat:

• de functie met CreateObject geeft het correcte resultaat.
• de functie met GetObject werkt niet. Volledig in de war: "Microsoft Office Excel has stopped working". Zie screenshot bij #5.

Grtz,
MDN111.

 

[snb]

Dan heb ik er nog eentje voor je om te testen:

Function F_snb(c00)
  With GetObject("", "Excel.Application")
    With .Workbooks.Open(c00)
      F_snb = .Sheets(1).Range("A1").Value
      .Close 0
    End With
  End With
End Function

 

[MDN111]

Dag snb !

Alhoewel ik geen gokker ben, ga ik hier toch een pronostiekje wagen. Ik heb het nog niet getest maar ik denk dat het wel gaat werken om deze reden: "If pathname is a zero-length string (""), GetObject returns a new object instance of the specified type. If the pathname argument is omitted, GetObject returns a currently active object of the specified type.". (https://msdn.microsoft.com/en-us/library/office/gg251785.aspx).

Ik laat straks iets weten.

Grtz,
MDN111.

 

[MDN111]

Nogmaals dag snb !

De functie werkt. Zowel met sub-aanroep als functie in cel.

Grtz,
MDN111.

 

[snb]

Ter vervolmaking; dan zou dit bij jou niet moeten werken:

Function F_snb(c00)
  With GetObject(, "Excel.Application")
    With .Workbooks.Open(c00)
      F_snb = .Sheets(1).Range("A1").Value
      .Close 0
    End With
  End With
end function