- Код: Выделить всё
Private Declare Function GetMem4 Lib "msvbvm60" _
(ByVal pSrc As Long, ByVal pDst As Long) As Long
Private Declare Function PutMem4 Lib "msvbvm60" _
(ByVal pDst As Long, ByVal NewValue As Long) As Long
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" _
(arr() As Any) As Long
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32.dll" _
(ByVal cDims As Long, ppsaOut As Any)
Private Declare Sub SafeArrayDestroyDescriptor Lib "oleaut32.dll" _
(psa As Any)
Private arrMain() As Long, arr1() As Long, arr2() As Long
Private Sub Form_Load()
Dim i As Long
ReDim arrMain(1 To 10)
CreateSAFEARRAY ArrPtr(arr1), 4, VarPtr(arrMain(1)), 1, 5
CreateSAFEARRAY ArrPtr(arr2), 4, VarPtr(arrMain(6)), 6, 10
For i = 1 To 10
arrMain(i) = i
Next
Me.AutoRedraw = True
Debug.Print "Главный массив:"
For i = 1 To 10
Debug.Print arrMain(i)
Next
Debug.Print
Debug.Print "Подмассив 1:"
Debug.Print LBound(arr1)
Debug.Print UBound(arr1)
For i = 1 To 5
Debug.Print arr1(i)
Next
Debug.Print
Debug.Print "Подмассив 2:"
Debug.Print LBound(arr2)
Debug.Print UBound(arr2)
For i = 6 To 10
Debug.Print arr2(i)
Next
End Sub
Private Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As _
Long, ByVal pData As Long, ParamArray Bounds()) As Long
Dim p As Long, i As Long
SafeArrayAllocDescriptor (UBound(Bounds) + 1) / 2, ByVal ppBlankArr
GetMem4 ppBlankArr, VarPtr(p)
PutMem4 p + 4, ElemSize
PutMem4 p + 12, pData
For i = 0 To UBound(Bounds) Step 2
PutMem4 p + 16 + i * 4, Bounds(i + 1) - Bounds(i) + 1
PutMem4 p + 20 + i * 4, Bounds(i)
Next
End Function
Private Function DestroySAFEARRAY(ByVal ppArray As Long) As Long
Dim p As Long
GetMem4 ppArray, VarPtr(p)
SafeArrayDestroyDescriptor ByVal p
PutMem4 ppArray, 0
End Function
Private Sub Form_Unload(Cancel As Integer)
DestroySAFEARRAY ArrPtr(arr1)
DestroySAFEARRAY ArrPtr(arr2)
End Sub
Идея очень интересная, однако, массивы не создаются (UBound<LBound, то есть верхняя граница =–1, а нижняя =0; что, собственно, обычно свидетельствует о пустом массиве) – выдаётся девятая ошибка (subscript out of range). Насколько я понимаю, мои изменения не могли никак повлиять на работу программы. Где собака порылась? В чём ошибка?
наоборот, данные в fixed length строке сохранятся, но... 
& vbCr