Excel-VBA zu PB-DLL: Übergabe eines Double-Arrays klappt nicht

[Klangtaucher]

Hallo mk-soft,

bekomme die Meldung:

Is not double
Falscher Parameter.

Hab' mal spaßeshalber probiert, einen StringArray bzw. einen VariantArray zu erzeugen bzw. zu übergeben: Die Meldung ist die gleiche.

Grüße

[Klangtaucher]

Der Vollständigkeit halber:

Es gibt hier einen Post von Kwai chang caine:
https://www.purebasic.fr/english/viewto ... d6d6c8f4d2

Mit dem Code funktioniert unter PB 4.5 eine String-Array Übergabe.

[mk-soft]

Hier ist es besser mit Variant zu arbeiten, da die anderen VBA Typen probleme machen.
Auch mit den Rückgabewert ist es of ein Probleme mit String oder Double.

Hier die Lösung mit Variant

Update 2

Code: Alles auswählen

EnableExplicit

IncludeFile "VariantHelper_Include.pb"

ProcedureDLL.i VariantLesen(*Var.variant, *Result.Variant)
  Protected r1.d, cnt, index, lbound, ubound, type
  Protected *psa.SAFEARRAY
  
  If *var\vt & #VT_ARRAY
    *psa = *var\parray
    
    type = saGetVartype(*psa)
    If type = #VT_R8
     cnt = saCount(*psa)
      lbound = saLBound(*psa)
      ubound = saUBound(*psa)
      For index = lbound To ubound
        r1 + SA_DOUBLE(*psa, index)
      Next
      VariantClear(*Result)
      ;V_DOUBLE(*Result) = r1
      *Result\vt = #VT_R8
      *Result\dblVal = r1
    Else
      MessageRequester("Info", "Array values is not Double" + #LF$ + saGetLastMessage())
    EndIf
  Else
    MessageRequester("Info", "Variant is not Array" + #LF$ + saGetLastMessage())
  EndIf
  ProcedureReturn 1
EndProcedure

ProcedureDLL.i VariantArray(*Var.variant, *Result.Variant)
  Protected r1.d, cnt, index, lbound, ubound, type
  Protected *psa.SAFEARRAY
  
  If *var\vt & #VT_ARRAY
    *psa = *var\parray
    type = saGetVartype(*psa)
    If type = #VT_VARIANT
      cnt = saCount(*psa)
      lbound = saLBound(*psa)
      ubound = saUBound(*psa)
      For index = lbound To ubound
        r1 + VT_DOUBLE(SA_VARIANT(*psa, index)) ; Typewandlung
      Next
      VariantClear(*Result)
      ;V_DOUBLE(*Result) = r1
      *Result\vt = #VT_R8
      *Result\dblVal = r1
    Else
      MessageRequester("Info", "Array values is not Variant" + #LF$ + saGetLastMessage())
    EndIf
  Else
    MessageRequester("Info", "Variant is not Array" + #LF$ + saGetLastMessage())
  EndIf
  ProcedureReturn 1
EndProcedure

ProcedureDLL.d DoubleArray(*pArray.integer)
  Protected r1.d, cnt, index, lbound, ubound, type
  Protected *psa.SAFEARRAY
  
  If *pArray And *pArray\i
    *psa = *pArray\i
    type = saGetVartype(*psa)
    If type = #VT_R8
      cnt = saCount(*psa)
      lbound = saLBound(*psa)
      ubound = saUBound(*psa)
      For index = lbound To ubound
        r1 + SA_DOUBLE(*psa, index)
      Next
      ProcedureReturn r1
    Else
      MessageRequester("Info", "Array values is not Double" + #LF$ + type)
    EndIf
  Else
    MessageRequester("Info", "No Pointer" + #LF$ + saGetLastMessage())
  EndIf
  ProcedureReturn 1
EndProcedure

Code: Alles auswählen

Option Explicit

Declare Function VariantLesen Lib "D:\Daten\Purebasic5\Ablage\VBA\VBAData.dll" (ByRef Value As Variant, ByRef Result As Variant) As Integer
Declare Function VariantArray Lib "D:\Daten\Purebasic5\Ablage\VBA\VBAData.dll" (ByRef Value As Variant, ByRef Result As Variant) As Integer
Declare Function DoubleArray Lib "D:\Daten\Purebasic5\Ablage\VBA\VBAData.dll" (ByRef Value() As Double) As Double

Function TestDouble(qwertz1 As Double)
    Dim TestArray(1) As Double
    Dim r1 As Double
    
    TestArray(0) = 21.5
    TestArray(1) = 22.5
    
    r1 = DoubleArray(TestArray)
    MsgBox "Result = " & r1
    TestDouble = r1
    
End Function

Function TestVariantDouble(qwertz1 As Double)
    Dim TestArray(1) As Double
    Dim Value As Variant
    Dim Result As Variant
    
    TestArray(0) = 21
    TestArray(1) = 22
    
    Value = TestArray
    If VariantLesen(Value, Result) = 1 Then
        MsgBox "Result = " & Result
        TestDouble = Result
    End If
    
End Function


Function TestArrayVariant(qwertz1 As Double)
    Dim Result As Variant
    Dim Value As Variant
    
    Value = Range("A1:A10") ' Array Of Variant
    
    If VariantArray(Value, Result) = 1 Then
        MsgBox "Result = " & Result
        TestArray = Result
    End If
    
End Function
Sub Schaltfläche1_Klicken()
    TestDouble (100)
End Sub

[SMaag]

Allerdings macht in VBA die Parameter-Übergabe nicht wirklich Spaß. Bis dato hatte ich Formeln mit bis zu 32 Parametern. Das ist recht nervig und fummlig. Arrays zu übergeben wäre deutlich einfacher.

Parameterübergabe von VBA nach Purebasic bei vielen Parametern.

Das würde auch mit Types (VB) vs. Structures (PB) gehen.

VB

Code: Alles auswählen

Public Type TParameter
  P1 As Double
  P2 As Double
  P3 As Double
End Tyte

Dim MyParaSet As TParameter

With MyParaSet
  .P1 = 1.1
  .P2 = 2.2
  .P3 = 3.3
EndWith

in PB

Code: Alles auswählen

Structure TParameter
  P1.d
  P2.d
  P3.d
Endstructure

Procedure.d TestCal(*Para.TParameter)
  With *Para
    Procedurereturn \P1 + \P2 + \P3
  Endwith
Endprocedure

[SMaag]

ich habe noche eine Möglichkeit, wie man einfach an die Arraydaten kommt.
Man kann in PB ein virtuelles statisches Array über die Daten legen. Ich hab leider kein Exel,
so dass ich das testen könnte.

hier der grundsätzliche Code dazu

Code: Alles auswählen

EnableExplicit

; Struktur um virtuelles Array auf Double Daten zu legen
Structure TptrDblArray 
  Dbl.d[0]
EndStructure

; Diese Dll-Procedure exportieren und in VBA einbinden. 
Procedure GetVBArray(*vbAry.SAFEARRAY)
  Protected ub, I
  Protected *vbA.TptrDblArray
    
  With *vbAry
    ub = \cbElements    ; Array Ubound  bzw ArraySize    
    *vbA = \pvData      ; Pointer virtuelles Array auf VBA Daten legen
  EndWith
  
  ; das sollte den Inhalt des Arrays in einem Consolen-Fenster ausgeben
  OpenConsole()
  For I = 0 To ub      
    PrintN(Str(*vbA\Dbl[I]))  ; jetzt kann man mit einem statischen PB-Array auf die Daten zugreifen
  Next                 
  Input()
    
EndProcedure

[mk-soft]

Update siehe oben ...

@SMaag

Leider übergibt VBA das Array nicht als SafeArray. Daher habe ich auch den Type Variant gewählt.

[Klangtaucher]

Hey mk-soft,

wow, es funktioniert.

Auch wenn die Rückgabe nicht dem üblichen Weg folgt - who cares ?
Mir war nicht klar, dass eine Rückgabe auch so erfolgen kann. Wieder was gelernt !

Mir war auch nicht klar, dass man für die „einfache“ Übergabe eines Arrays von Excel an eine DLL das Wissen eines Informatikstudiums benötigt…..

VIELEN DANK FÜR DEINE HILFE !

@Smaag
Auch Danke für Deine Hilfe !

Grüße

[mk-soft]

Ich bin nur Techniker, aber schon zu lange dabei

[SMaag]

Super wenn es funktioniert! So wächst die community!

Hab jetzt meinen alten VB code auch wieder gefunden. Ich hab 2006 mal ein Erweiterungs-DLL in Assembler
für VB/VBA geschrieben. Dort hab ich den Pointer auf die SafeArray-Struktur eines Array wie folgt ermittelt.
Die Arrayübergabe musste man As Any definieren.

Code: Alles auswählen

' ===========================================================================
' NAME: IsArrayDim
' DESC: Ermittelt ob ein Array (SafeArray) dimensioniert ist
'
' PARA(VbArray): Array-Pointer
' RET(EAX):      vbFalse = undimensioniert; vbTrue=dimensioniert
' ===========================================================================

Public Declare Function IsArrayDim Lib "vbExt.dll" _
         (vbArray() As Any) As Boolean

' ===========================================================================
' NAME: PtrArrayStrukt
' DESC: Ermittelt den Pointer der zugehörigen SafeArrayStruktur des Arrays
' DESC: und gibt diesen zurück. Um den Pointer der SafeArrayStruktur zu setzen,
' DESC: die Funkion HookArray (hängt SafeArrayStruktur ein), verwenden!
'
' PARA(Array):
' RET:  Pointer auf SafeArrayStruktur
' ===========================================================================

Public Declare Function ptrArrayStrukt Lib "vbExt.dll" _
         (vbArray() As Any) As Long

hier der ASM Code dazu

Code: Alles auswählen

; ===========================================================================
;  NAME: IsArrayDim
;  DESC: Ermittelt ob ein Array (SafeArray) dimensioniert ist 
;
;  PARA(VbArray): Array-Pointer
;  RET(EAX):      vbFalse = undimensioniert; vbTrue=dimensioniert
; ===========================================================================

IsArrayDim proc
    mov edx, [esp+4]            ; von VB übergebene Adresse des Arrays in EDX
    mov eax, [edx]              ; an dieser Adresse steht der SafeArray-Pointer
    test eax, eax               ; SafeArray-Pointer <> 0 prüfen
    JNZ @dim                    ; ist <> 0 => Array ist dimensioniert
    xor eax, eax                ; undemiensioniert; 0 (vbFalse) zurückgeben
    jmp @ret
@dim:                           ; dimensioniert
    xor eax, eax                ; eax :=0
    not eax                     ; eax :=-1 (vbTrue)
@ret:    
    ret 4   
IsArrayDim endp

; ===========================================================================
;  NAME: ptrArrayStrukt
;  DESC: Ermittelt den Pointer der zugehörigen SafeArrayStruktur des Arrays
;  DESC: und gibt diesen zurück. Um den Pointer der SafeArrayStruktur zu setzen, 
;  DESC: die Funkion HookArray (hängt SafeArrayStruktur ein), verwenden!0
;
;  PARA(Array):
;  RET:  Pointer auf SafeArrayStruktur
; ===========================================================================

ptrArrayStrukt proc
    mov edx, [esp+4]            ; Adresse Array
    mov eax, [edx]              ; SafeArray-Pointer Array 
    ret 4
ptrArrayStrukt endp

Daraus nochmals in PB-Programm gebastelt. Könntest du das auch mal testen, ob das dann so funktioniert?

Code: Alles auswählen

EnableExplicit

; Struktur um virtuelles Array auf Double Daten zu legen
Structure TptrDblArray 
  Dbl.d[0]
EndStructure

; in VB/VBA
; Public Declare Function GetVbArray Lib "MyDllName.dll" (vbArray() As Any) As Long

Procedure.l GetVbArray(*VB_Array)
  Protected *psa.SAFEARRAY  ; Pointer to SafeArrayStructure
  Protected *vbA.TptrDblArray
  Protected ub, I
  
  If *VB_Array
    *psa = PeekI(*VB_Array)  
  EndIf
  
  If *psa
    With *psa
      ub = \cDims
      *vbA = \pvData
    EndWith
  EndIf
  
  ; das sollte den Inhalt des Arrays in einem Consolen-Fenster ausgeben
  OpenConsole()
  For I = 0 To ub      
     PrintN(Str(*vbA\Dbl[I]))  ; jetzt kann man mit einem statischen PB-Array auf die Daten zugreifen
  Next                 
  Input()
  
 EndProcedure

[mk-soft]

Noch mal getestet ...

Array Of Double geht doch. Hier wird aber der Pointer auf die Variable übergehen welchen Pointer auf das SafeArray enthält.
Es ist aber doch Besser mit Variant zu arbeiten da diese mehr Möglichkeiten hat und ein Range direkt angegeben kann.

Link Update: https://www.purebasic.fr/german/viewtop ... 40#p366940