形状放置和形状计数器

时间:2015-04-01 10:12:05

标签: excel vba shapes

我在VBA Excel中有一些关于形状的问题。

我有A栏和B栏。他们将会这样展示。

    A            B
1 | some text    1 to 5 shapes
2 | blabla       OOOO

我想通过用户表单输入文本和形状。因此,如果用户选择“1”,我希望在B列的单元格左侧显示一个形状。如果用户选择“3”,我希望3个形状在B列中彼此相邻。

另外,如果有人首先选择了3个形状,并且想要将其改为4个形状,我必须将第4个形状放在正确的位置。

如果我改变列的宽度,所有这一切仍然有效。

我真的google了很多,但我似乎无法找到正确的解决方案。

1 个答案:

答案 0 :(得分:2)

这一点对我有用,但当然你必须修改以使用你自己的形状和目的。

Sub DrawShapesInPlace(shapeCell As Range, numShapes As Integer, Optional gap As Double = 3#)
    Dim cellW As Double
    Dim cellH As Double
    Dim shapeW As Double
    Dim shapeUL As Double
    Dim shapeTop As Double
    Dim shapeH As Double
    Dim i As Integer
    Dim newShape As Shape

    If numShapes < 1 Then
        Exit Sub
    End If

    cellW = shapeCell.Width
    cellH = shapeCell.Height
    shapeW = (cellW / numShapes) - gap
    shapeUL = shapeCell.Left
    shapeTop = shapeCell.Top
    shapeH = cellH

    For i = 1 To numShapes
        Set newShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                                                   shapeUL, _
                                                   shapeTop, _
                                                   shapeW, _
                                                   shapeH)
        newShape.Line.Weight = 1
        shapeUL = shapeUL + gap + shapeW
    Next i
End Sub

Sub DrawShapes()
    Call DrawShapesInPlace(ActiveSheet.Range("D9"), 3)
End Sub