- Код: Выделить всё
Private WithEvents m As clsObjectExtender
Private c As Object
Private Sub LoadExcel_Click()
Set m = New clsObjectExtender
Set c = CreateObject("excel.application")
If Not m.Attach(c) Then
MsgBox "couldn't connect to c", vbExclamation
Exit Sub
End If
c.Visible = True
c.WorkBooks.Add
End Sub
Private Sub m_EventRaised(ByVal strName As String, params() As Variant)
On Error Resume Next
Dim i As Long
MsgBox "Event " & strName
' event name
Debug.Print "m_Event: " & strName, ;
' test the bounds
i = UBound(params)
If Err Then
Debug.Print ""
Exit Sub
End If
' parameters values
For i = 1 To UBound(params)
If IsObject(params(i)) Then
Debug.Print "Param " & i & ": IS OBJECT "
Else
Debug.Print "Param " & i & ": " & params(i), ;
End If
Next
Debug.Print ""
End Sub
change sub for support object Params(args) :
- Код: Выделить всё
Private Function pvGetParamArray(ByVal Ptr As Long) As Variant()
Dim tDPAR As DISPPARAMS
Dim SafeArray As SAFEARRAY_1D
Dim aTmpParams() As Variant
Dim aParams() As Variant
Dim lIdx As Long
' DISPPARAMS structure
CpyMem tDPAR, ByVal Ptr, Len(tDPAR)
If tDPAR.cArgs = 0 Then Exit Function
' array pointing to the param array
With SafeArray
.Bounds(0).cElements = tDPAR.cArgs
.Bounds(0).lLBound = 0
.cDims = 1
.cbElements = 16
.pvData = tDPAR.rgPointerToVariantArray
End With
CpyMem ByVal VarPtrArray(aTmpParams), VarPtr(SafeArray), 4&
' copy elements
ReDim aParams(1 To tDPAR.cArgs)
For lIdx = 1 To tDPAR.cArgs
If IsObject(aTmpParams(tDPAR.cArgs - lIdx)) Then
Set aParams(lIdx) = aTmpParams(tDPAR.cArgs - lIdx)
Else
aParams(lIdx) = aTmpParams(tDPAR.cArgs - lIdx)
End If
Next
' return the parameters
pvGetParamArray = aParams
' destroy the array
CpyMem ByVal VarPtrArray(aTmpParams), 0&, 4&
End Function
