Error message even when picture folder is open

Ivylodge · #1 09-16-2018, 03:33 AM

Hi,

Could you assist as to why i get a run time error message 104,unable to get the insert property of the pictures class.

I enter a part number & then leave the cell.
I see the msgbox.
I click on Yes.
Now i see the error message BUT also the picture folder opens.
I close the picture folder and now the error message is shown on the screen.

I dont need to see this error message as i selected Yes to open the picture folder.

Please can you advise how i stop this message showing.
Thanks very much

Code:

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\LOCK 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\")
        Else
        Exit Sub
    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

eduzs · #2 09-16-2018, 05:34 AM

"...LOCK PICK ME\" & "\" & Target.Value..." The problem maybe here, try:

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

Ivylodge · #3 09-16-2018, 05:53 AM

Thanks for the quick reply.
Changing that still give me the same issue.

When i close the picture folder and the error message is shown,clicking on debug then shows me the following in yellow.

Code:

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

macropod · #4 09-16-2018, 02:25 PM

Quote:

Originally Posted by eduzs

"...LOCK PICK ME\" & "\" & Target.Value..." The problem maybe here, try:

Quote:

Originally Posted by eduzs

Try to remove the ".jpg"

Seems to me you two are just guessing...

Ivylodge: There seem to be some gaps in your code's logic. Try:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Shp As Shape, StrFldr As String
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub

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

If Target.Value = "" Then Exit Sub

StrFldr = "C:\Users" & Environ("UserName") & "\Desktop\SKYPE\LOCK PICK ME\"
If Dir(StrFldr & 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
    With Application.Dialogs(xlDialogInsertPicture)
      If .Show <> -1 Then
        Set Shp = .SelectedItems(1)
      Else
        Exit Sub
      End If
    End With
  Else
    Exit Sub
  End If
Else
  Set Shp = ActiveSheet.Pictures.Insert(StrFldr & Target.Value & ".jpg")
End If

With Shp
  .Top = Target.Offset(0, 1).Top + 5
  .Left = Target.Offset(0, 1).Left + 5
  .LockAspectRatio = msoFalse
  .Height = Target.Offset(0, 1).Height - 10
  .Width = Target.Offset(0, 1).Width - 10
End With
Target.Offset(1, 0).Select
End Sub

Note also that I've replaced your AND tests with nested IF tests; it's more efficient that way. I've also used Excel's own InsertPicture dialogue rather than the Shell object.

macropod · #5 09-16-2018, 06:15 AM

Please post Excel programming questions in the Excel programming forum, not in the Word VBA forum. Thread moved.

trevorc · #6 09-16-2018, 01:17 PM

Try removing the .select at the end of the line.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Showing userform in document open results in error message	LimpingBuf	Word VBA	3	07-13-2018 06:42 PM
Error Message Received When Attempting to Open Doc in WORD or Publisher	k5jim	Word	1	01-25-2016 03:17 PM
Problem opening Outlook Today. Error Message: Cannot display the folder. Cannot find this file. Veri	atwnsw	Outlook	0	11-01-2015 05:05 PM
Error message when trying to open excel file	Glenda	Excel	1	08-03-2015 07:12 AM
Automation error Unknown error" message once they open the Excel file	hlina	Excel	1	10-08-2013 09:14 PM