So, dann mal los! Viell wird's dann klarer,...
16.12.2009 13:25:07
Luc:-?
...Tino!
Du weißt ja, dass sowohl die XLM-Fkt AUSWERTEN als auch die vbFkt Evaluate die Angabe der ganzen Fml als String verlangen. Enthält diese ebenfalls Strings müssen diese in verdoppelte An-/Ausführungszeichen gesetzt wdn. Auch, wenn ein analoges Konstrukt als Bestandteil einer automatisch generierten Prozedur direkt geschrieben wird, muss das so sein. Und um irgendetwas in dieser Art scheint es hier zu gehen. Irgendein (? Fremd-)Pgm benötigt die Angabe in genau dieser Form, sonst fkt es nicht. Der Anfang des gezeigten Wertes scheint darauf hinzudeuten — sieht wie 'ne (? ud/Fremd-)Fkt aus. Was die dann mit diesen Texten, die eigentl Namen sein könnten macht, weiß keiner. In VBA-generierten Fmln würde man hier Namen verwenden und dann wären die zusätzl String-Marker tatsächlich überflüssig. Allerdings würde das auch in VBA Sinn machen, wenn es Namen wären, die von einer generierten Prozedur verwendet wdn. Dann wäre die Schreibweise nämlich Range("namexyz") — schon benötigt man zusätzl String-Marker! Das adaptierende (? VBA-/Fremd-)Pgm scheint das nicht automatisch zu machen wie es bspw im Folgd der Fall ist...
Function XFunc() 'maxZlLänge noch nicht berücksichtigt!
Rem XFuncGen:XInStr-Platzhalter XFunc-Operation
End Function
Function varFkt(ByVal XFktN As String, xArg, ParamArray XArgg())
Rem --- DummyX-FctProc created by CyWorXxl:FXss.XFuncGen on 16.12.09 ---
' Achtung - xArg nur b.Bedarf - XFktN-Argg unter XArgg eintragen!
' B.Fktseinsatz in VBA b.Nichtbedarf f.xArg Null übergeben!
Const xModN As String = "cxModul" 'hier StdOrt-Modul von XFunc einsetzen!
Dim cp As VBComponent, psl As Long, xa As Variant, xf As String, mmf As Boolean, ac As _
Range
On Error Resume Next
With Application
If IsError(.Caller) Then Set ac = ActiveCell Else Set ac = .Caller.Cells(1)
mmf = ac.HasArray And ac.Cells.Count > 1
End With
If Not IsMissing(xArg) And Not IsError(xArg) And Not IsNull(xArg) Then
If Not mmf Then
If Left(xArg, 1) = "(" Then xf = "(": xArg = Mid(xArg, 2)
Else: xArg = ""
End If
End If
If Left(XFktN, 1) = "." Then
xf = vbTab & "XFunc = " & xf & "WorksheetFunction" & XFktN & "("
ElseIf Left(XFktN, 1) = ":" Then
xf = vbTab & "XFunc = " & xf & "Evaluate(""" & Mid(XFktN, 2) & "("
' ElseIf VBAdapter(XFktN) Then
' xf = vbTab & "XFunc = " & xf & "VBAdapter(""" & XFktN & """, "
Else: xf = vbTab & "XFunc = " & xf & XFktN & "("
End If
With WorksheetFunction
For Each xa In XArgg
If IsMissing(xa) Then
xa = ""
ElseIf IsNull(xa) Then
xa = "Null"
ElseIf IsEmpty(xa) Then
xa = "Empty"
ElseIf IsError(xa) Then
If CInt(xa) = 2000 Or CInt(xa) = 2042 Then _
xa = "Null" Else xa = "CVErr(" & CInt(xa) & ")"
ElseIf IsArray(xa) Then
Exit Function 'damit es auch bei dir fktioniert!
' xa = VBAdapter("RinMxList", xa, -2)
' xa = Replace(Replace(xa, "{", "Array("), "}", ")")
ElseIf .IsText(xa) Then
xa = """" & xa & """"
Else: xa = Replace(Trim(CStr(xa)), ",", ".")
End If
xf = xf & xa & ","
Next xa
End With
xf = Left(xf, Len(xf) - 1) & ")"
If Not IsMissing(xArg) Then
If Not IsError(xArg) Then
If IsNumeric(Mid(xArg, 3)) Then xArg = Replace(xArg, ",", ".")
xf = xf & xArg
End If
End If
For Each cp In ActiveWorkbook.VBProject.VBComponents
If cp.Name = xModN Then
With cp.CodeModule
psl = .ProcStartLine("XFunc", vbext_pk_Proc)
While Left(.Lines(psl, 1), 8) "Function": psl = psl + 1: Wend
.ReplaceLine psl + 1, xf
xArg = XFunc()
.ReplaceLine psl + 1, vbTab & "Rem XFuncGen:varFkt-Platzhalter XFunc-Operation"
End With
Exit For
End If
Next cp
varFkt = xArg
End Function
Wenn du das mal ausprobieren willst, ist zu beachten, dass XFunc quasi als eine Art Register für alle Einsätze solcher Fktt dient. Bei Mehrfacheinsatz der generierten Universal-udF varFkt im Blatt muss deshalb der manuelle Berechnungsmodus gewählt wdn (sonst wird's katastrophal!). Übrigens kannst du damit auch jede vbFkt auswerten — alles Andere wird sich dir aus dem FktKörper erklären... ;-)
Viel Spaß! Gruß Luc :-?