不使用SELECT插入形状

时间:2016-01-21 17:19:52

标签: excel vba excel-vba

我的一段代码遍历一系列单元格,如果某个单元格满足某些条件,则在此单元格中插入形状。它有效,但我想找出一种避免select的替代方法。

'above - code to find satisfying cell
ActWS.Activate       'Activate Sheet
ActWS.Cells(rActPlan - 1, vReturnColumn).Select 'Select satisfying cell
ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
Selection.ShapeRange.Fill.Visible = msoFalse
 With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 255, 0)
        .Weight = 2.25
 End With

2 个答案:

答案 0 :(得分:5)

此代码删除了所有.SelectActiveCell引用:

With ActWs

    Dim rng as Range
    Set rng = .Cells(rActPlan - 1, vReturnColumn)

    Dim shp as Shape
    Set shp = .Shapes.AddShape(msoShapeOval, rng.Left, rng.Top, rng.Width, rng.Height)

    With shp.ShapeRange

        .Fill.Visible = msoFalse

        With .Line
           .Visible = msoTrue
           .ForeColor.RGB = RGB(0, 255, 0)
           .Transparency = 0
           .Weight = 2.25
        End With

    End With

End With

答案 1 :(得分:3)

AddShape()会返回刚添加的形状对象,因此您应该可以使用类似下面代码的内容 - 然后引用shp代替Selection

Dim shp as Shape
Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, _
                   ActiveCell.Top, ActiveCell.Width, ActiveCell.Height)