VBA Excel, массив форм.Как исправить ошибку «Указатель на указанную коллекцию выходит за пределы»?

Question

В Excel у меня есть три фигуры с именами ON_1, ON_2 и ON_3.Я пытаюсь построить массив индексов Shape и получить ShapeRange.У меня есть код VBA, но я получаю сообщение об ошибке;Индекс в указанную коллекцию выходит за пределы.Вот код:

Sub test()

Dim sht As Worksheet
Dim shprng As ShapeRange
Dim shape_index As Variant
Dim i As Long

Set sht = ActiveSheet

ReDim shape_index(1 To sht.Shapes.Count)
For i = 1 To UBound(shape_index)
    shape_index(i) = i
Next

Set shprng = sht.Shapes.Range(shape_index)

End Sub

Я ожидаю получить переменную shprng, чтобы включить все shapenames в массив.

Но вместо этого я получаю ошибку с этой строкой кода:

Set shprng = sht.Shapes.Range(shape_index)

Ошибка времени выполнения 1004: индекс в указанной коллекции выходит за пределы

Есть идеи?

Answer 1

Попробуйте это ...

Sub test()
    Dim sht As Worksheet
    Dim shprng As ShapeRange
    Dim shape_index() As Variant
    Dim i As Long

    Set sht = ActiveSheet

    ReDim shape_index(1 To sht.Shapes.Count)
    For i = 1 To UBound(shape_index)
        shape_index(i) = i
    Next

    Set shprng = sht.Shapes.Range(shape_index)
End Sub

Эта строка ...

Dim shape_index As Variant

... была ваша проблема. Первоначально он не был объявлен как массив.

Вот теперь это ...

Dim shape_index() As Variant

Answer 2

Вы можете использовать эти исправления:

• Нет необходимости использовать массив variant большой памяти.Для вашей цели достаточно простого массива Integer.
• Проверьте, является ли .Shapes.Count 0, иначе ваш код не будет работать
• (Необязательно). Фактический размер массива можно получить с помощью UBound(shape_index) - LBound(shape_index) + 1 (даже если в этом случае это не так.необходимо, потому что вы уже знаете свою нижнюю границу)

С этими исправлениями теперь это работает.Вот код:

Sub test()
    Dim sht As Worksheet
    Dim shprng As ShapeRange
    Dim shape_index() As Integer
    Dim i As Long

    Set sht = ActiveSheet

    'If no shape is present, exit sub
    If sht.Shapes.Count = 0 Then Exit Sub

    ReDim shape_index(1 To sht.Shapes.Count)
    For i = 1 To UBound(shape_index) - LBound(shape_index) + 1
        shape_index(i) = i
    Next

    Set shprng = sht.Shapes.Range(shape_index)

End Sub

Надеюсь, это поможет.