Как выровнять фигуры с помощью VBA Loop - PullRequest
0 голосов
/ 11 июля 2019

Мой код зацикливает диапазон ячеек, который, в свою очередь, добавляет форму со значением ячеек, если значение ячейки в диапазоне больше 1.

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

В настоящее время мой код размещает каждую фигуру поверх друг друга.

Код

Sub foo()
Dim oval As Shape
Dim rCell As Range
Dim rng As Range
Dim h As Integer
Dim w As Integer
Dim x As Long
Dim shp As Object

h = h + 50 + 2
w = w + 200 + 2
Set rng = Sheet1.Range("A1:A7")



For Each rCell In rng

If rCell > 0 Then

    Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 1, w + 1, 75, 80)

With oval
    .Line.Visible = True
    .Line.Weight = 8
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame.Characters.Caption = rCell.Value
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    .TextFrame.VerticalAlignment = xlVAlignCenter
    .TextFrame.Characters.Font.Size = 22
    .TextFrame.Characters.Font.Bold = True
    .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
End With

End If

    Next rCell

End Sub

Скриншот enter image description here

1 Ответ

5 голосов
/ 11 июля 2019

Какая-то математика должна делать свое дело. 95 - это ширина 75 плюс поле 20. Отрегулируйте при необходимости.

For Each rCell In rng
    If IsNumeric(rCell.Value) Then
        If rCell.Value > 0 Then
            Dim counter As Long
            counter = counter + 1

            Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 95 * (counter - 1), w + 1, 75, 80)

            With oval
                .Line.Visible = True
                .Line.Weight = 8
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .TextFrame.Characters.Caption = rCell.Value
                .TextFrame.HorizontalAlignment = xlHAlignCenter
                .TextFrame.VerticalAlignment = xlVAlignCenter
                .TextFrame.Characters.Font.Size = 22
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            End With
        End If
    End If
Next rCell

Обратите внимание, что Shapes.AddShape имеет аргументы Тип , Слева , Верх , Ширина , Высота , поэтому использование h и w для Левый и Верх немного сбивает с толку.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...