Ошибка «Элемент с указанным именем не найден» при попытке сгруппировать фигуры на листе

Question

Я пишу программу VBA, чтобы выборочно сгруппировать некоторые прямоугольники со скругленными угламиБудут наборы этих групп, поэтому я хочу сохранить их в массиве.(Например, я хотел бы, чтобы dataSeriesGroup (1) имела группу, скажем, трех прямоугольников со скругленными углами, dataSeriesGroup (2) - группу из трех других прямоугольников со скругленными углами и т. Д.).Я пытаюсь назначить их группе, используя атрибут .Name, следующим образом:

Dim ctr, ctr2, seriesCount, dataCount as Integer
Dim dataSeriesGroup() as Shape
Dim dataPoint() as Shape
Dim dTop, dLeft, dWidth, dHeight as long
Dim dataPointName as Variant

<Bunch of code to calculate values of dTop, dLeft, dWidth, dHeight, seriesCount, dataCount>

Redim dataSeriesGroup(seriesCount)
Redim dataPoint(dataCount, dataSeriesCount)
Redim dataPointName(dataCount)

For ctr = 1 to seriesCount

 For ctr2 = 1 to dataCount
   Set dataPoint(ctr2, ctr) = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, dLeft, dTop, dWidth, dHeight)
   dataPointName(ctr2) = dataPoint(ctr2, ctr).Name
 Next ctr2

Set dataSeriesGroup(ctr) = Activesheet.Shapes(Array(dataPointName)).Group

Next ctr

Все работает нормально, но когда я пытаюсь установить dataSeriesGroup (ctr), я получаю сообщение об ошибке "Ошибка времени выполнения '-2147352571 (80020005)': элемент с указанным именем не найден. "

Может кто-нибудь дать несколько советов относительно того, что я делаю неправильно?

Answer 1

Проблема заключается в способе объявления переменной datapointName.Вы хотите построить массив, который будет вести себя так же, как и возвращаемый функцией Array, которая возвращает массив вариантов, начинающийся с нуля :

Dim datapointName() As Variant '<== Notice the parentheses.

Осторожно с ReDims, как правило, вы не хотите, чтобы в дальнем конце ваших массивов висели пустые значения, поэтому:

ReDim dataPointName(0 To dataCount - 1) '<== That's dataCount elements!

Также см. комментарии в примере кода ниже относительно объявления переменных.

Наконец, используйте свойство Range коллекции Shapes, чтобы получить подмножество, и удалите вызов к Array(), так как dataPointName уже таков:

Set dataSeriesGroup(seriesIndex) = ActiveSheet.Shapes.Range(dataPointName).Group

Собрав все вместе, вотнекоторый функциональный демонстрационный код, основанный на вашем:

Sub DoTheShapesThing()
    'Note: in VBA, to each variable its type; otherwise: Variant.
    'I've renamed some variables for clarity.
    Dim seriesIndex As Integer
    Dim dataIndex As Integer
    Dim seriesCount As Integer
    Dim dataCount As Integer
    Dim dataSeriesGroup() As Shape
    Dim dataPoint() As Shape
    'Haven't altered your position and size variables, but the type should typically be Double.
    Dim dTop As Long
    Dim dLeft As Long
    Dim dWidth As Long
    Dim dHeight As Long
    Dim dataPointName() As Variant '<== Here, the parentheses make all the difference! You want an array of Variants, just like the Array function returns.

    'I've added this declaration for the code to compile. REMOVE IT! You've probably declared this variable elsewhere.
    Dim dataseriesCount As Long

    'Test values...
    seriesCount = 2
    dataCount = 2
    dataseriesCount = seriesCount '<== Note that dataseriesCount must be >= seriesCount so the code below doesn't go "Subscript out of range".
    dLeft = 100: dTop = 100: dWidth = 100: dHeight = 100

    ReDim dataSeriesGroup(0 To seriesCount - 1)
    ReDim dataPoint(0 To dataCount - 1, 0 To dataseriesCount - 1)
    ReDim dataPointName(0 To dataCount - 1)

    For seriesIndex = 0 To seriesCount - 1
        For dataIndex = 0 To dataCount - 1
            'Took some liberties with shape disposition here...
            Set dataPoint(dataIndex, seriesIndex) = ActiveSheet.Shapes.AddShape( _
                msoShapeRoundedRectangle, _
                dLeft + 10 * (seriesIndex + dataIndex), _
                dTop + 10 * (seriesIndex + dataIndex), _
                dWidth, _
                dHeight)

            dataPointName(dataIndex) = dataPoint(dataIndex, seriesIndex).Name
        Next dataIndex

        Set dataSeriesGroup(seriesIndex) = ActiveSheet.Shapes.Range(dataPointName).Group
    Next seriesIndex
End Sub