Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub ShapeTest()
- Dim ActiveShape As Shape
- Dim ShapeCell As Range
- Application.ScreenUpdating = False
- Set ShapeCell = ActiveSheet.Range("A1")
- Set ActiveShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ShapeCell.Left, ShapeCell.Top, ShapeCell.Width, ShapeCell.Height)
- ActiveSheet.Rows(1).Insert shift:=xlShiftDown
- Application.ScreenUpdating = True
- End Sub
Add Comment
Please, Sign In to add comment