Disable selection of shapes
Hi. I have a macro that will place a shape (either a
circle or rectange) in several cells based on the value in the cell. I want the user to be able to change the value of the cell, but I do not want them to be able to select the shape that is in the cell. Could someone tell me how to accomplish this? My code is included below. Thanks, Mike. Private Sub Worksheet_Change(ByVal Target As Range) Dim myrange As Range Dim myCell As Range Dim myOval As Shape Dim mySquare As Shape Dim pbar, lcl, ucl Dim n As Integer Dim pbarn As Variant Dim lastRow As Integer 'This statement find the last row of the spreadsheet lastRow = Rows.Find(What:="Percentage").Row Set myrange = Worksheets("Practice").Range("c26:y" & lastRow - 2) For Each myCell In myrange.Cells 'The following with statement calculates the control limits for each individual 'entry on the chart and places red squares or green circles around the entry. With myCell pbar = Range("A" & .Row) n = myrange(lastRow - 26, .Column - 2) pbarn = pbar * n lcl = pbarn - 2.58 * Sqr(pbarn * (1 - pbar)) ucl = pbarn + 2.58 * Sqr(pbarn * (1 - pbar)) If .Value < lcl Then Set myOval = .Parent.Shapes.AddShape (Type:=msoShapeOval, _ Top:=.Top + 1, Left:=.Left + 2, Width:=.Width - 4, Height:=.Height - 2) myOval.Fill.Visible = msoTrue myOval.Line.Weight = 1.5 myOval.Line.ForeColor.SchemeColor = 17 myOval.Fill.ForeColor.SchemeColor = 11 myOval.Fill.Transparency = 0.85 End If If .Value ucl Then Set mySquare = .Parent.Shapes.AddShape (Type:=msoShapeRectangle, _ Top:=.Top + 1.5, Left:=.Left + 1.5, Width:=.Width - 3, Height:=.Height - 3) mySquare.Fill.Visible = msoTrue mySquare.Line.Weight = 1.5 mySquare.Line.ForeColor.SchemeColor = 10 mySquare.Fill.ForeColor.SchemeColor = 10 mySquare.Fill.Transparency = 0.85 End If End With Next myCell Set myrange = Worksheets("Practice").Range("c39:y" & lastRow) For Each myCell In myrange.Cells 'The following with statement calculates the control limits for the totals row ' and places red squares or green circles around the entry. With myCell pbar = Range("A" & lastRow - 2) n = myrange(0, .Column - 2) pbarn = pbar * n If n 0 Then lcl = pbar - 2.58 * Sqr(pbar * (1 - pbar) / n) ucl = pbar + 2.58 * Sqr(pbar * (1 - pbar) / n) If .Value < lcl Then Set myOval = .Parent.Shapes.AddShape (Type:=msoShapeOval, _ Top:=.Top + 1, Left:=.Left + 2, Width:=.Width - 4, Height:=.Height - 2) myOval.Fill.Visible = msoTrue myOval.Line.Weight = 1.5 myOval.Line.ForeColor.SchemeColor = 17 myOval.Fill.ForeColor.SchemeColor = 11 myOval.Fill.Transparency = 0.85 End If If .Value ucl Then Set mySquare = .Parent.Shapes.AddShape (Type:=msoShapeRectangle, _ Top:=.Top + 1.5, Left:=.Left + 1.5, Width:=.Width - 3, Height:=.Height - 3) mySquare.Fill.Visible = msoTrue mySquare.Line.Weight = 1.5 mySquare.Line.ForeColor.SchemeColor = 10 mySquare.Fill.ForeColor.SchemeColor = 10 mySquare.Fill.Transparency = 0.85 End If End If End With Next myCell End Sub |
Disable selection of shapes
The only way I know of to prevent shapes from being selected is to protect
the worksheet (Tools, Protection, Protect Sheet). -- Jim Rech Excel MVP |
Disable selection of shapes
A partial solution is a "Null" subroutine, like the following:
Sub ClickMe() End Sub This has the effect of nullifying the mouse left-click selection function very nicely. Unfortunately, I know of no way to prevent the right-click selection. If someone in the NG knows how to capture right-click event for a shape, we might have a full solution here. HT(partially)H, Alex J "Jim Rech" wrote in message ... The only way I know of to prevent shapes from being selected is to protect the worksheet (Tools, Protection, Protect Sheet). -- Jim Rech Excel MVP |
Disable selection of shapes
Good thought about assigning a null macro. It might eliminate most
"accidental" selections. Besides the right-click another issue is Ctrl-click. I do think sheet protection is a good approach though, unlocking the cells users can change in advance. -- Jim Rech Excel MVP |
All times are GMT +1. The time now is 03:29 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com