Event Code Error trying to insert a picture

[pmnaughton]

I am trying to get a picture to insert and am following the suggestion below.
After pasting the code into the “View Code†window the following error
appears on the first “Dim†statement in the code. I get "Microsoft Visual
Basic Complie Error: Expected: End of Statement". What am I doing wrong?


Copy the code below, right click the sheet tab, select "View Code" and
paste the code into the window that appears. I've assumed that your pictures
are stored on a sheet named "Pictures" and that Jane Doe's picture is named
"Jane Doe", and that the cell you want to enter the name into is cell A2, so
that the picture appears in cell A1. HTH, Bernie MS Excel MVP Private Sub
Worksheet_Change(ByVal Target As Range) Dim myShape As Shape Dim SC As Range
Dim mySh As Worksheet If Target.Cells.Count > 1 Then Exit Sub If
Target.Address <> "$A$2" Then Exit Sub Application.EnableEvents = False
Application.ScreenUpdating = False Set mySht = ActiveSheet On Error Resume
Next For Each myShape In mySht.Shapes If myShape.Name Like "*Final" Then
myShape.Delete Next myShape Worksheets("Pictures").Select
ActiveSheet.Shapes(Target.Value).Select Selection.Copy mySht.Select
Target.Offset(-1, 0).Select ActiveSheet.Paste Selection.Name = "'" &
mySht.Name & "'!" & Selection.Name & "Final" Target.Select
Application.EnableEvents = True Application.ScreenUpdating = True End Sub

 

[GB]

Not sure how literal you were about your copying and pasting, but and I'm not
trying to be a smart @$$ is the code broken up into it's logical parts and
lines?

Dim mySh as Worksheet

If Target.cells....

Application.EnableEvents = False

Application..... etc..?

 

[RadarEye]

Hi pmnaughton

The formatting look a bit odd, so I rearanged it to de code below.
I had an error olso but corrected the code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myShape As Shape
Dim SC As Range
Dim mySht As Worksheet
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address <> "$A$2" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Set mySht = ActiveSheet
On Error Resume Next
For Each myShape In mySht.Shapes
If myShape.Name Like "*Final" Then myShape.Delete
Next myShape
Worksheets("Pictures").Select
ActiveSheet.Shapes(Target.Value).Select
Selection.Copy
mySht.Select
Target.Offset(-1, 0).Select
ActiveSheet.Paste
Selection.Name = "'" & mySht.Name & "'!" & Selection.Name &
"Final"
Target.Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

HTH,

Wouter