Although you can use CopyMemory
and FillMemory
, I'd strongly advise that you never keep these references around for too long. As an example I made stdRefArray
class based on this exact principle, DO NOT USE THIS CODE! Read on to find out why...:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'I STRONGLY RECOMMEND AGAINST USING THIS CLASS. SEE WHY HERE:
'https://stackoverflow.com/a/63838676/6302131
'Status WIP
'High level wrapper around 2d array.
#Const DEBUG_PERF = False
'Variables for pData
Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)
Public Data As Variant
Private Const VARIANT_SIZE As Long = 16
Public Function Create(ByRef Data As Variant) As stdRefArray
Set Create = New stdRefArray
Call Create.Init(Data)
End Function
Public Sub Init(ByRef DataIn As Variant)
'Create direct reference to array:
CopyMemory Data, DataIn, VARIANT_SIZE
End Sub
Private Sub Class_Terminate()
'Clean up array reference
FillMemory Data, VARIANT_SIZE, 0
End Sub
Public Function GetData(ByVal iRow as long, ByVal iCol as long) as Variant
Attribute GetData.VB_UserMemID=0
GetData = GetData(iRow,iCol)
End Function
My initial idea of using this class was to do something like the following:
Cars.FindCar(...).GetDoor(1).Color = Rgb(255,0,0)
where the Car class has a reference to the Cars array, and similarly with the Door class stores a reference to the Cars array, allowing for "instant" setters straight to the source of the initial data.
This works fine! But...
I came across massive issues while debugging. If you're in debug mode, in the Door class, in the color setter, if you make a change to the structure which will need recompilation I.E. Change the name of a dim
ed variable, change the name of a method/property, or changed their types, Excel will instantly crash. A similar thing will occur when you click the VBA stop (square) button. Not only this, but it is extremely nasty to debug these instant crashes from Excel...
This makes the above code ensure the rest of your code base is also difficult to maintain. It will increase time to make fixes, cause a lot of frustration and make. The time saved in runtime doesn't justify the time it'll take to fix issues around it.
If you do ever make these array references ensure you keep their lives incredibly short, and adequately comment in between regarding debugging issues.
Note: If anyone can find a work around this crash issue (i.e. properly clean up the stack prior to VBA crash, I'd be very interested!)
Instead I highly suggest you use a simple class like this:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Status WIP
'High level wrapper around arrays
Public Event Changed(ByVal iRow As Long, ByVal iCol As Long, ByVal Value As Variant)
Public vData As Variant
Public Function Create(ByRef Data As Variant) As stdRefArray
Set Create = New stdRefArray
Call Create.Init(Data)
End Function
Public Sub Init(ByRef Data As Variant)
'Slow, but a stable reference
vData = Data
End Sub
Public Property Get Data(Optional ByVal iRow As Long = -1, Optional ByVal iCol As Long = -1) As Variant
Attribute Data.VB_UserMemId = 0
If iRow = -1 And iCol = -1 Then
CopyVariant Data, vData
ElseIf iRow <> -1 And iCol <> -1 Then
CopyVariant Data, vData(iRow, iCol)
Else
stdError.Raise "stdRefArray::Data() - Invalid use of Data", vbCritical
End If
End Property
Public Property Let Data(ByVal iRow As Long, ByVal iCol As Long, Value As Variant)
vData(iRow, iCol) = Value
RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Set Data(ByVal iRow As Long, ByVal iCol As Long, Value As Object)
Set vData(iRow, iCol) = Value
RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Get BoundLower(ByVal iDimension As Long) As Long
BoundLower = LBound(vData, iDimension)
End Property
Public Property Get BoundUpper(ByVal iDimension As Long) As Long
BoundUpper = UBound(vData, iDimension)
End Property
Private Function CopyVariant(ByRef dest As Variant, ByVal src As Variant)
If IsObject(src) Then
Set dest = src
Else
dest = src
End If
End Function
I've added a few extra steps which will help with bindings. You do still very much lose a lot of native behaviour, however this is the safest bet which is also the easiest to maintain. It will also be the fastest way to get collection-like functionality without using a collection.
Usage, Car.cls
:
Private WithEvents pInventory as stdRefArray
Public Function Create(ByRef arrInventory as variant)
Set Create = new Car
Set Create.pInventory = stdRefArray.Create(arrInventory)
End Function
Public Function GetDoor(ByVal iRow as long) as Door
Set GetDoor = new Door
GetDoor.init(pInventory,iRow)
End Function
Door.cls
Private pArray as stdRefArray
Private pRow as long
Private Const iColorColumn = 10
Sub Init(ByVal array as stdRefArray, ByVal iRow as long)
set pArray = array
pRow = iRow
End Sub
Public Property Get Color() as long
Color = pArray(pRow,iColorColumn)
End Property
Public Property Let Color(ByVal iNewColor as long)
pArray(pRow,iColorColumn) = iNewColor
End Property
The example probably isn't too great lol, but hopefully you get the idea.