如何从VBA绘制矩形并为其分配宏? [英] How to draw rectangles and assign macros to them from VBA?

问题描述

这就是我想要做的，我真的不知道该怎么做或是否有可能.我有一栏会生成一些值.假设列号是10.我要怎么做...如果该列中一个单元格的值大于1，我想绘制一个矩形(在下一个单元格或靠近该单元格的位置)(第11列同一行)，并为其分配了一个宏.宏将在该单元格所在的位置以及将要绘制矩形的位置之后插入另一行，因此我必须以某种方式获取该矩形的位置.有任何想法吗?非常感谢！

Here's what I want to do and I really don't know how to do it or if it is possible. I have one column where some values are generated. Let's say the column number is 10. What I want to do... if the value of a cell in that column is > 1 I want to draw a rectangle (in the next cell or close to that cell) (column 11 same row) with a macro assigned to it. The macro will insert another row right after that one where the cell is and where the rectangle will be drawn so I have to get somehow the position of the rectangle. Any ideas? Thanks a lot!

推荐答案

Sub Tester()
Dim c As Range

    For Each c In ActiveSheet.Range("A2:A30")
        If c.Value > 1 Then
            AddShape c.Offset(0, 1)
        End If
    Next c

End Sub


Sub AddShape(rng As Range)
    With rng.Cells(1).Parent.Shapes.AddShape(msoShapeRectangle, rng.Left, _
                                    rng.Top, rng.Width, rng.Height)
        .OnAction = "DoInsertAction"
    End With
End Sub

Sub DoInsertAction()
    Dim r As Long
    r = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    ActiveSheet.Rows(r + 1).Insert Shift:=xlDown
End Sub

这篇关于如何从VBA绘制矩形并为其分配宏?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！