Вставка картинки краш Excel

Question

У меня есть код цикла, который вставляет изображения в ячейки столбца А. Однако я не могу справиться с проблемой, когда в каталоге нет изображения. Если нет изображения, мой макрос завершается с ошибкой и завершает работу программы.

Если я удаляю обработчики ошибок, я получаю ошибку времени выполнения "1004" при вставке изображений классов.

У меня есть сообщение об ошибке возобновить на следующей строке, но это не помогает, я также сделал if ppath (путь к изображениям) <> "", тогда продолжайте. Я думал, что это помогло, но какое-то время он работал, а иногда - сбой в Excel.

Sub insert_foto()

Dim i As Long
Dim ppath As String
Dim lastrow As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Worksheets("RS")
lastrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    With ws
        ws.Range("A6:A" & lastrow).RowHeight = 90
    End With

On Error Resume Next

For i = 6 To lastrow

    'photo in column A
    ppath = "http://aa/bb/" & CStr(Cells(i, 2).Value & "-F1.jpg")
   If ppath <> "" Then
    With ActiveSheet.Pictures.Insert(ppath)
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 50
            .Height = 85
        End With
        .Left = ActiveSheet.Cells(i, 1).Left + (ActiveSheet.Cells(i, 1).Width - .Width) / 2
        .Top = ActiveSheet.Cells(i, 1).Top + (ActiveSheet.Cells(i, 1).Height - .Height) / 2
        .Placement = 1
        .PrintObject = True
    End With
   End If
Next

Application.ScreenUpdating = True
End Sub

Answer 1

On Error Resume Next довольно глупая команда. Это заставит среду выполнения VBA продолжить выполнение следующего оператора, если что-то не получится Вы должны использовать его, только если

• вы знаете, что делаете (вы знаете, что конкретное утверждение может не в состоянии),
• Вы справляетесь с ошибкой самостоятельно
• вы ограничиваете область действия только одним оператором, который может завершиться ошибкой, выполнив оператор On Error Goto 0, который активирует обычную обработку ошибок VBA.

В противном случае вы будете скрывать все ошибки времени выполнения, и в конце вы будете удивлены, почему ваша программа не работает, и понятия не имеете, что происходит.

В следующем коде я ограничиваю область утверждением, где изображение вставляется в лист, и проверяю, было ли оно успешным. Если нет, моя переменная будет Nothing, и я знаю, что что-то не получилось.

Обычно при работе с файлами вы можете проверить его наличие с помощью Dir -команды, но в вашем случае вы хотите прочитать изображения, используя http, а это не работает с Dir , В любом случае, независимо от того, откуда исходит изображение, могут быть и другие причины, чем файл не найден , почему изображение не может быть загружено (права доступа, файл не является допустимым изображением ...).

Есть еще одна проблема с вашим кодом. Вы объявляете переменную листа ws (что хорошо), но вы ее не используете (это плохо). Вы не должны работать с ActiveSheet - это часто приводит к ошибкам, и нет необходимости, чтобы лист был active . Я добавил использование переменной ws. Часто вместо того, чтобы писать что-то вроде ws.Cells, используется выражение With (в этом случае вы можете написать .Cells, но не забывайте начальную точку!), Но в этом примере у нас уже есть 2 вложенный With, а введение другого приведет к путанице.

Итак, вот код. Как видите, я сохраняю результат Insert в промежуточной переменной и проверяю, установлен ли он.

For row = 6 To lastrow
    Dim ppath As String
    'photo in column A
    ppath = "http://aa/bb/" & CStr(ws.Cells(row, 2).Value & "-F1.jpg")

    If ppath <> "" Then
        Dim pic As Picture
        On Error Resume Next                   ' The next statement may fail
        Set pic = ws.Pictures.Insert(ppath)    ' Try to insert image
        On Error GoTo 0                        ' Back to default error handling

        If pic Is Nothing Then
            ws.Cells(row, 1) = "Could not load " & ppath

        Else
            With pic
                With .ShapeRange
                    .LockAspectRatio = msoFalse
                    .Width = 50
                    .Height = 85
                    .Left = ws.Cells(row, 1).Left + (ws.Cells(row, 1).Width - .Width) / 2
                    .Top = ws.Cells(row, 1).Top + (ws.Cells(row, 1).Height - .Height) / 2
                End With
                .PrintObject = True
                .Placement = 1
            End With
            Set pic = Nothing
        End If

   End If
Next

Answer 2

Вы можете проверить, существует ли файл, используя "Dir".Если он возвращает пустую строку, он не существует.Так что я бы сделал это:

If ppath <> "" and Dir(ppath) <> "" Then

Если произойдет сбой, даже если файл существует, вы можете посчитать количество изображений на листе перед вставкой и попробовать вставить новый, пока количество изображений не станетвыше, чем было.(Doevents помогает вам выйти из кода, если после многих попыток вставка не сработает.)

NrOfPicsBeforeInsert = ActiveSheet.Pictures.Count

On Error Resume Next

Do While NrOfPicsBeforeInsert = ActiveSheet.Pictures.Count
    ActiveSheet.Pictures.Insert ppath
    DoEvents
Loop

On Error GoTo 0

При таком подходе может потребоваться ссылка на последнее изображение, добавленное другим способом:

With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
    With .ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 50
        .Height = 85
    End With
    .Left = ActiveSheet.Cells(i, 1).Left + (ActiveSheet.Cells(i, 1).Width - .Width) / 2
    .Top = ActiveSheet.Cells(i, 1).Top + (ActiveSheet.Cells(i, 1).Height - .Height) / 2
    .Placement = 1
    .PrintObject = True
End With