Can you check my code please

[ipbr21054]

Hi,
Code is supplied below.
There is a couple of things ive noticed.

In cell A i type say 12345 when i leave that cell i see the error message which advises photo 12345 does not exist,then yes/no box.
If i click No the msgbox closes & then the photo is inserted into the cell.
If i click YES the folder for pictures opens & when i then close it down then the photo is also inserted into that cell.

The msgbox should only be shown when there is no photo in the folder to be inserted into the cell.

Private Sub Worksheet_Change(ByVal Target As Range)Dim shp As Shape
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
On Error GoTo son


For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then shp.Delete
Next


If Target.Value <> "" And Dir("C:\Users\Ian\Desktop\SKYPE\PICK ME\" & "\" & Target.Value & ".jpg") = "" Then 'picture not there!
    If MsgBox("Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then


        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\")
        
End If
End If


ActiveSheet.Pictures.Insert("C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\" & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 1).Top + 5
Selection.Left = Target.Offset(0, 1).Left + 5


With Selection.ShapeRange
.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 1).Height - 10
.Width = Target.Offset(0, 1).Width - 10
End With
Target.Offset(1, 0).Select
son:


End Sub

 

[shg]

Maybe (untested),

Private Sub Worksheet_Change(ByVal Target As Range)
  Const sPath       As String = "C:\Users\Ian\Desktop\SKYPE\PICK ME\"
  Dim shp           As Shape

  With Target
    If .Cells.CountLarge = 1 And .Column = 1 And (.Row Mod 20) <> 0 Then
      On Error GoTo NeverMind

      For Each shp In Me.Shapes
        If shp.Type = msoPicture And shp.TopLeftCell.Address = .Offset(, 1).Address Then shp.Delete
      Next shp

      If Len(.Value) Then
        If Len(Dir(sPath & Target.Value & ".jpg")) Then
          Set shp = Me.Pictures.Insert(sPath & .Value & ".jpg")
          With shp
            .Top = .Offset(, 1).Top + 5
            .Left = .Offset(, 1).Left + 5
            .LockAspectRatio = msoFalse
            .Height = .Offset(, 1).Height - 10
            .Width = .Offset(, 1).Width - 10
          End With
          .Offset(1, 0).Select

        Else  ' no picture
          If MsgBox("Photo " & .Value & " Doesn't exist" & vbLf & _
                    "Open The Picture Folder?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then
            CreateObject("Shell.Application").Open sPath
          End If
        End If
      End If
    End If
  End With
NeverMind:
End Sub

You might spend some quality time at http://www.cpearson.com/excel/debuggingvba.aspx

 

[ipbr21054]

Hi,
That didnt insert an image & it didnt take me to the picture folder when yes was selected.
Thanks

 

[shg]

Time to step through the code.

 

[ipbr21054]

Can you advise as ive seen it done but which key is needed to press

 

[MARK858]

Can you advise as ive seen it done but which key is needed to press

Have you read the link shg posted in post number 2?????

 

[ipbr21054]

Yes
But whether i put the cursor at the end or the start F8 has no affect,even if i select step in from the menu

 

[shg]

Keep reading.

You can't step into a procedure that requires arguments; you need to set a breakpoint.