Macro

[Richard]

Need help with this macro. Allows my scorecard to update indicator lights
depending on performance. However, I can't get the lights to center in the
cell. This same macro would center the indicator image in Excel 2002 but
does not work in 2007. Any ideas?


Public Sub Update_Light_Images()
On Error GoTo HandleError:

Dim myCell As Range
Dim OrigCell As Range
Dim ScorecardSheet As Worksheet
Dim ImageName As String
Dim sh As Shape

Set OrigCell = Selection
Set ScorecardSheet = Range("KeyCells").Worksheet

With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With

'delete all of the Stoplight images but leave the other pictures
'The name of the other pictures on the page must not end with "Image"
For Each sh In ScorecardSheet.Shapes
Select Case Right(sh.Name, 5)
Case "Image"
sh.Delete
Case Else
'don't delete the object
End Select
Next

'For the KeyCell named range cells, paste in an image ball
'from the worksheet 'Images' that corresponds to the value
'text from the KeyCell -- Red, Green, Yellow.
For Each myCell In Range("KeyCells")
Select Case myCell.Value
Case "Red", "Yellow", "Green"
ScorecardSheet.Activate
ImageName = myCell.Address & "Image"
Sheets("Images").Shapes(myCell.Value & "Ball").Copy
ScorecardSheet.Activate
myCell.Select
ActiveSheet.Paste
Selection.Name = ImageName
Selection.ShapeRange.ZOrder msoBringToFront
End Select
Next myCell

Range("a1").Select

OrigCell.Worksheet.Activate
OrigCell.Select

SubFinish:
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With

Exit Sub
HandleError:
Select Case Err.Number
Case -2147024809 'if the image name doesn't exist
Resume Next
Case Else
Resume Next
' MsgBox Err.Number & ": " & Err.Description
' GoTo SubFinish
End Select
End Sub