【VBA】非配列のVariant型変数に格納した配列のLBoundや要素数を変えてみた

SafeArrayRedim を使うと、
非配列のVariant型変数に格納した配列でも、LBoundとかElementsとかの変更ができる。

だまって、
ReDim Preserve v(2 To 4)
とかすればいいんだけど・・・

ソース

Private Type SAFEARRAYBOUND
    cElements   As Long
    lLbound     As Long
End Type

Private Declare Function SafeArrayRedim Lib "OleAut32" (ByVal psa As Long, ByRef psaboundNew As SAFEARRAYBOUND) As Long

Private Declare Sub MoveMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Public Sub redimVariantArray()

    Dim v   As Variant

    v = Array(1, 2, 3)

    Dim psa As Long
    Dim isDynamicArray  As Boolean

    psa = getSafeArrayPointer(v, isDynamicArray)

    If psa = 0 Then
        Debug.Print "Target is not initialized."

        Exit Sub
    ElseIf Not isDynamicArray Then
        Debug.Print "Target is not Dynamic Array."

        Exit Sub
    End If

    Debug.Print "Before"
    Debug.Print "LBound:" & LBound(v)
    Debug.Print "UBound:" & UBound(v)
    Debug.Print ""

    Dim sab As SAFEARRAYBOUND

    sab.cElements = UBound(v) - LBound(v) + 1
    sab.lLbound = LBound(v) + 2

    Call SafeArrayRedim(Not Not psa, sab)

    Debug.Print "After"
    Debug.Print "LBound:" & LBound(v)
    Debug.Print "UBound:" & UBound(v)

End Sub

Public Sub redimVariantRefArray()

    Dim v   As Variant
    Dim lArray() As Long

    ReDim lArray(3)

    lArray(0) = 2
    lArray(1) = 3
    lArray(2) = 4
    lArray(3) = 5

    v = lArray

    Dim psa As Long
    Dim isDynamicArray  As Boolean

    psa = getSafeArrayPointer(v, isDynamicArray)

    If psa = 0 Then
        Debug.Print "Target is not initialized."

        Exit Sub
    ElseIf Not isDynamicArray Then
        Debug.Print "Target is not Dynamic Array."

        Exit Sub
    End If

    Debug.Print "Before"
    Debug.Print "LBound:" & LBound(v)
    Debug.Print "UBound:" & UBound(v)
    Debug.Print ""

    Dim sab As SAFEARRAYBOUND

    sab.cElements = UBound(v) - LBound(v) + 2
    sab.lLbound = LBound(v) + 2

    Call SafeArrayRedim(Not Not psa, sab)

    Debug.Print "After"
    Debug.Print "LBound:" & LBound(v)
    Debug.Print "UBound:" & UBound(v)

End Sub

Public Function getSafeArrayPointer(ByRef v As Variant, ByRef isDynamicArray As Boolean) As Long

    Const VT_ARRAY          As Integer = &H2000
    Const VT_BYREF          As Integer = &H4000

    Const FADF_STATIC       As Integer = &H2
    Const FADF_FIXEDSIZE    As Integer = &H10

    Const OFFSET_VT         As Long = 0&
    Const OFFSET_PARRAY     As Long = 8&
    Const OFFSET_FFEATURES  As Long = 2&

    Dim pArray  As Long
    Dim vt      As Integer

    isDynamicArray = False

    Call MoveMemory(vt, v, Len(vt))

    If (vt And VT_ARRAY) = 0 Then
        '配列ではない
        Exit Function
    End If

    'VARIANTのparrayのアドレス
    Call MoveMemory(pArray, ByVal VarPtr(v) + OFFSET_PARRAY, Len(pArray))

    If (vt And VT_BYREF) = VT_BYREF Then
        'VARIANTのpparrayから、parrayのアドレスを引っ張ってくる
        Call MoveMemory(pArray, ByVal pArray, Len(pArray))
    End If

    If pArray = 0 Then
        'Redimがまだか、Eraseした後
        Exit Function
    End If

    Dim fFeatures   As Integer

    Call MoveMemory(fFeatures, ByVal pArray + OFFSET_FFEATURES, Len(fFeatures))

    isDynamicArray = CBool((fFeatures And (FADF_STATIC Or FADF_FIXEDSIZE)) <> (FADF_STATIC Or FADF_FIXEDSIZE))

    getSafeArrayPointer = pArray

End Function

実行結果

redimVariantArray

Before
LBound:0
UBound:2

After
LBound:2
UBound:4

redimVariantRefArray

Before
LBound:0
UBound:3

After
LBound:2
UBound:6