Имейте фигуры/изображения друг под другом, а не сверху

#excel #vba

Вопрос:

Я нашел этот фрагмент кода:

 With ws.Shapes
        numShp = .Count
        If numShp > 1 Then
            autoShp = 0
            ReDim shpArray(1 To numShp)
            For y = 1 To numShp
                If .Item(y).Type = msoAutoShape Then
                    autoShp = autoShp   1
                    shpArray(autoShp) = .Item(y).Name
                End If
            Next y
            If autoShp > 1 Then
                ReDim Preserve shpArray(1 To autoShp)
                Set asRng = .Range(shpArray)
                asRng.Distribute msoDistributeVertically, False
            End If
        End If
    End With

Это в значительной степени делает то, что мне нужно с остальной частью моего кода, но каждый объект формы/изображения находится друг над другом. Мне нужно, чтобы они располагались друг под другом.
Другой уважаемый участник предлагает мне использовать этот код для заказа изображений, но я получил ошибку «индекс в указанной коллекции находится за пределами» в ws.Shapes(0).Top = 0 :

 Dim ws As Worksheet

Set ws = xlBook.Sheets("Sheet2")

With ws.Range("A" amp; Rows.Count).End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count)
  .UnMerge
   rng.CopyPicture appearance:=xlScreen, Format:=xlPicture
   .PasteSpecial
 End With

 If ws.Shapes.Count = 1 Then ' position at top
    ws.Shapes(0).Top = 0
 Else
  ws.Shapes(ws.Shapes.Count).Top = ws.Shapes(ws.Shapes.Count - 1).Height   5 ' or whatever gap      you want
 End If

Я безрезультатно рылся в паутине.

1. нет Shapes(0) , это начинается с 1

2. Что произойдет, если вы просто переключитесь For y = 1 To numShp на For y = numShp To 1 Step -1 . Это позволило бы переупорядочить фотографии и получить их так, как вы хотите, верно?

3. @toddleson В numShp = .count есть объектная переменная или с переменной блока не установлена ошибка

4. и @Warcupine это не ошибка, но фигуры все еще находятся друг на друге

5. является ли numShp объектной переменной?

Ответ №1:

Я собираюсь сосредоточиться на втором из блоков кода, основываясь на вашем вопросе / комментариях, я не думаю, что первый из них на самом деле то, что вы ищете.

Во втором я добавил петлю, чтобы она обрабатывала все ваши фигуры. Он разместит их слева, начиная с самого верха.

Я исправил вычисления в Else заявлении, которое должно было перекрываться, если у вас более двух фигур, так как оно не учитывало начальное местоположение.

     Dim ws As Worksheet
    Dim i As Long

    Set ws = Sheets("Sheet2")
    For i = 1 To ws.Shapes.Count
        If i = 1 Then ' position at top
            ws.Shapes(i).Top = 5 ' You can do 0 but it looks (isn't actually) off screen a little.
        Else
            ws.Shapes(i).Top = ws.Shapes(i - 1).Top   ws.Shapes(i - 1).Height   5 ' or whatever gap you want
        End If
    Next