asked on

Prevent users from manually moving a shape to a different row on a worksheet

Hi

I have a project planning spreadsheet that allows users to move shapes (rectangles) along a row (left or right) and to modify the width of the rectangles, depending on the duration of a project activity. However, it is important that the rectangles stay in their designated rows, as each row represents a different project activity. 'Snap to Grid' is enabled, to make this easier for the user.

Is there any way in VBA to detect if a rectangle has been moved to a different row and either prevent this from happening, or have it move back to where it was originally?

I'm assuming this will be something to do with detecting that a shape has been selected or moved and establishing its TopLeftCell and/or BottomRightCell properties, but I have no idea how to stop the user from dragging it to a different row.

Any help would be appreciated.

Regards

Terry

Rob Henson

Don't know of a way of preventing vertical movement. Using VBA to check the top left cell would prevent you moving left/right, using bottom right may stop you from adjusting size.

I have see Conditional formatting used for Project Timelines so the actual cells get filled rather than having shapes over the cells.

Martin Liss

You could protect the sheet.

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Saqib Husain

Consider posting a sample working file so that we can see the precise scenario you are working in and (possibly) suggest a more appropriate solution.

Terrygordon

ASKER

Hi Brad

As so many times in the past, I have gone with a variation of your solution. Thankfully, the rectangles are named in numerical sequence, which, although it doesn't match the row number, allows the row to be specified by identifying the number element of the name and adding a constant to it to identify the row it should be in.

I've solved it by using a Worksheet_SelectionChange event to loop through each rectangle when the user selection changes, to make sure they are all in the right rows and reposition them, if they are not.

For the benefit of anyone who needs a similar solution, I have included an example from the code below. I won't post the whole thing, but, for a single rectangle, it is:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim shp As Shape

For Each shp In ActiveSheet.Shapes

If shp.Name = "Rectangle1" Then
If shp.TopLeftCell.Row <> 4 Then shp.Top = Cells(4, 4).Top
End If

Next shp

Open in new window

This repositions rectangle1 to row 4, if it has been moved. The column reference in the Cells statement is redundant, because I am only repositioning the row, i.e. it will stay in the same column that the user moved it to, but move to row 4, in this example.

Thanks for the suggestion.

Regards

Terry

byundt

Terry,
If all your shapes are named Rectanglexxx, then you can simplify your code to:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape
Dim rw As Long

On Error Resume Next
For Each shp In ActiveSheet.Shapes
    rw = 0
    If shp.Name Like "Rectangle*" Then
        rw = Val(Replace(shp.Name, "Rectangle", "", , , vbTextCompare))
        If (rw > 0) And (shp.TopLeftCell.Row <> (rw + 3)) Then shp.Top = Cells(rw + 3, 4).Top
    End If
Next shp
On Error GoTo 0
End Sub

Open in new window

Brad