#1
|
|||
|
|||
Error message even when picture folder is open
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 |
#2
|
|||
|
|||
"...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
__________________
Backup your original file before doing any modification. |
#3
|
|||
|
|||
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 |
#4
|
||||
|
||||
Please post Excel programming questions in the Excel programming forum, not in the Word VBA forum. Thread moved.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Try removing the .select at the end of the line.
|
#6
|
||||
|
||||
Quote:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
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 |