Msgbox YesNo advice

[ipbr21054]

Eventing.

I have the code show below.

I need some some advice please for the correct code so when Yes is selected I am taken to a specific folder.
I can’t advise the path at present but stuck with the main code for when Yes is selected.

[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)Dim shp As Shape[/COLOR]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\LOCK PICK ME\" & "\" & Target.Value & ".jpg") = "" Then
        'picture not there!
         MsgBox "Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found"
         Exit Sub
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:

 [COLOR=#000000]End Sub[/COLOR]

 

[ipbr21054]

Hi,
Ive tried that but do you see this message after you click Yes on the msgbox ?

 

[mumps]

No, I don't get any error message. When you click "Debug", which line of code is highlighted?

 

[RoryA]

The code doesn't exit if you choose to open the picture folder, but the picture still isn't there and subsequent code tries to insert it, so you should get an error really.

 

[ipbr21054]

I understand post #13

This is the line of code,
ActiveSheet.Pictures.Insert("C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME" & Target.Value & ".jpg").Select

Please see this short clip.

http://www.theremotedoctor.co.uk/forums/excel.mp4

 

[mumps]

@RoryA: Thank you for that. If I should be getting an error, I don't know why it's not happening for me.

 

[mumps]

@RoryA: Would there be some code that could detect when the picture folder is closed and exit the macro when it is closed?

 

[RoryA]

If the idea is to get the user to locate the file, I’d use application.getopenfilename instead.

 

[ipbr21054]

Can you advise where i need to apply this.

Using it like below i get not supported.

Application.GetOpenFilename("C:\Users\Ian\Deskapplication.getopenfilenametop\SKYPE\LOCK PICK ME\" & Target.Value & ".jpg").Select

Using it like below when i click outside of the cell then i see a browse box open,this is with a photo in the picture folder.

If i enter a part number for where no picture is in the folder up pops the msgbox and i then select Yes.
The picture folder open.
I close down the picture folder then straight away the same browse box open.
If i then close down this folder i get a run time error 424 object required.
Clicking on debug i see the line of code shown in yellow.

Application.GetOpenFilename.Insert("C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\" & Target.Value & ".jpg").Select

This is the line of code in yellow.

Application.GetOpenFilename.Insert("C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\" & Target.Value & ".jpg").Select

So its kind of the same issue in a way providing ive entered it in the correct place.

 

[RoryA]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim shp                   As Shape
    Dim picPath               As String
    Dim vFile

    picPath = "C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\"

    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
        End If
    Next

    If Target.Value <> "" Then
        picPath = picPath & Target.Value & ".jpg"
        If Dir(picPath) = "" Then    'picture not there!
            If MsgBox("Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then
                ' prompt to select the picture file
                vFile = Application.GetOpenFilename(filefilter:="JPEG image files (*.jpg), *.jpg", Title:="Select image file")
                ' exit if they cancelled
                If vFile = False Then
                    Exit Sub
                Else
                    picPath = vFile
                End If
            Else
                Exit Sub
            End If
        End If
    End If
    With Target.Offset(0, 1)
        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picPath, _
                                                linktofile:=msoFalse, savewithdocument:=msoTrue, _
                                                Left:=.Left + 5, Top:=.Top + 5, Width:=-1, Height:=-1)    ' -1 means use default size
        shp.LockAspectRatio = msoFalse
        shp.Height = .Height - 10
        shp.Width = .Width - 10
    End With
son:

End Sub

 

[ipbr21054]

That works better.

I notice 2 things.

1,
When i click Yes to the msgbox a generic browse folder opens as opposed to the picture folder which path is shown below & would be nice to just go straight to that.

C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\

2,
A part number is entered in cell A but there is no picture in the folder so the msgbox is shown.
I then select No on the msgbox.
I then delete the part number that was just entered into cell A and i then see a message An error occurred while importing this file C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\
I then click OK and see a run time error 1004,Application defined or object defined error.
I click on debug and the code below is shown in yellow.

        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picPath, _                                                linktofile:=msoFalse, savewithdocument:=msoTrue, _
                                                Left:=.Left + 5, Top:=.Top + 5, Width:=-1, Height:=-1)    ' -1 means use default size