Way to tell if ActiveSheet.Pictures.Insert(Filename).Select Fails?

Question

I have made an excel macro for my company that mass inserts images in a picture folder by their cell value.

The cell.Value contains the SKU number, so I add the rest of the file path in a for each loop and then use ActiveSheet.Pictures.Insert(Filename).Select.

Everything works great, but when files are not found within the picture folder, the filepath is left in the cell. I would like to change all cells that don't find an image to say "No Image" rather than the filepath.

Is there anyway to test if ActiveSheet.Pictures.Insert(Filename).Select failed to find an image, then I could rewrite the cell.Value if it failed?

I've tried to add another For each loop to see if the cell.Value has contents in it. This is because the insert image portion runs a cell.ClearContents once it's done so all the cells with images inserted don't have their SKU numbers behind the image. I'm having trouble with this process as well and would like to avoid for eaching through the selection twice.

Option Explicit
Dim rng As Range
Dim cell As Range
Dim Filename As String
Sub PictureImport()



Set rng = ActiveSheet.Range("A2:A3000")
For Each cell In Selection '<-- *For Each cell In rng* For Hard Coded selection
If cell.Value <> "" Then cell.Value = "\\Pictures\" & cell.Value & ".jpg" '<---NEEDS TO SKIP HEADER
Next

    Dim theShape As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("A2:A3000")   ' <---- CHANGE TO START AT A2 TO SKIP HEADER
    For Each cell In Selection
        Filename = cell
        If InStr(UCase(Filename), "JPG") > 0 Then   '<--- ONLY USES JPG'S
            ActiveSheet.Pictures.Insert(Filename).Select
            Set theShape = Selection.ShapeRange.Item(1)
            If theShape Is Nothing Then GoTo isnill
            xCol = cell.Column
            Set xRg = Cells(cell.Row, xCol)
            With theShape
                .LockAspectRatio = msoFalse
            ' Shape position and sizes stuck to cell shape
                .Top = cell.Top + 1
                .Left = cell.Left + 1
                .Height = cell.Height - 2
                .Width = cell.Width - 2
            ' Move with the cell (and size, though that is likely buggy)
            .Placement = xlMoveAndSize
            End With

            cell.ClearContents

isnill:
            Set theShape = Nothing
            Range("A2").Select
        End If
    Next

    Debug.Print "Done " & Now

    Application.ScreenUpdating = True

End Sub

Actual Results as stands: Images in the pictures folder will be inserted to the size of the cell, but will leave the cells that could not find a picture with the file path still in the the cell value.

Check if the file exists first using `If Dir(filename) = "" Then` — Rory, Jun 25 '19 at 13:28
`On Error Resume Next` is a bad idea, if you don't know exactly what you're doing — Nacorid, Jun 25 '19 at 13:34
`ActiveSheet.Pictures.Insert(Filename).Select` -- is that supposed to insert and select the image? Also, it's best to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — BruceWayne, Jun 25 '19 at 13:58

Way to tell if ActiveSheet.Pictures.Insert(Filename).Select Fails?

0 Answers0