VBA多维数组转一维数组

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Type SafeArrayBound
    cElements As Long '// 该维的长度
    lLbound   As Long ' // 该维的数组存取的下限，一般为0
End Type

Private Type SafeArray
    cDims      As Integer ' // 数组的维度
    fFeatures  As Integer '
    cbElements As Long ' // 数组元素的字节大小
    cLocksas   As Long '
    pvDataas   As Long ' // 数组的数据指针
    rgsabound() As SafeArrayBound
End Type

Sub TestToOneDim()
    Dim arr() As String
    ReDim arr(1, 2, 3) As String
    
    VBA.Randomize
    
    Dim i As Long, j As Long, k As Long
    For i = 0 To UBound(arr)
        For j = 0 To UBound(arr, 2)
            For k = 0 To UBound(arr, 3)
                arr(i, j, k) = VBA.Format(i, "x0") & VBA.Format(j, "\y0") & VBA.Format(j, "z0=") & VBA.Format(VBA.Rnd() * 100, "0")
            Next
        Next
    Next
    
    ToOneDim arr
    
    Debug.Print VBA.Join(arr, "|")
End Sub

Function ToOneDim(arr As Variant) As Long
    If Not VBA.IsArray(arr) Then
        ToOneDim = -1
        Exit Function
    End If
    
    Dim ptr As Long
    Dim sa As SafeArray
    
    ptr = MyArrayPtr(arr)
    
     '获取SafeArrayBound之前的数据
    CopyMemory VarPtr(sa.cDims), ptr, 16
    If sa.cDims = 1 Then Exit Function
    
    ReDim sa.rgsabound(sa.cDims - 1) As SafeArrayBound
    '根据维度再读取需要的数据
    CopyMemory VarPtr(sa.rgsabound(0).cElements), ptr + 16, sa.cDims * 8
    
    '修改为一维
    '修改rgsabound(0)的个数
    Dim i As Long
    For i = 1 To sa.cDims - 1
        sa.rgsabound(0).cElements = sa.rgsabound(0).cElements * sa.rgsabound(i).cElements
    Next
    sa.cDims = 1
    
    '反写到数组
    CopyMemory ptr, VarPtr(sa), 16
    CopyMemory ptr + 16, VarPtr(sa.rgsabound(0).cElements), 8
End Function

Function MyArrayPtr(ByRef v As Variant) As Long
    Dim b(16 - 1) As Byte
    
    CopyMemory VarPtr(b(0)), VarPtr(v), 16
'    Printf "b = 0x% x", b
    
    Dim ptr As Long
    CopyMemory VarPtr(ptr), VarPtr(b(8)), 4
'    - 0x20 8-11存的是数组地址
'    - 0x60 8-11存的是数组地址的地址
    If b(1) = &H60 Then
        CopyMemory VarPtr(ptr), ptr, 4
    End If
    
    MyArrayPtr = ptr
End Function