Tratamento Erro em VBA continuar execução

Question

Preciso de um auxilio com a query abaixo onde busco as imagens em um diretório e vou inserindo em um planilha, porém quando a imagem não for encontrada no diretório, quero exibir a mensagem para o usuário e continuar a execução da próxima linha em diante...e assim sucessivamente...como devo ajustar meu tratamento de erro, pois hoje da forma que tenho montado, quando isso ocorre a execução é terminada.

Obrigado

Sub Insere_Figura_celula()
'
'Macro gravada por Claiton Orth - 04/06/2013
'
Dim Coluna As String
Dim Linha As Integer
Dim Celula As String
Dim Coluna_Figura As String
Dim Celula_Figura As String

Coluna = Range("G3")
Linha = Range("G5")
Celula = Coluna & Linha
Coluna_Figura = Range("G4")
Celula_Figura = Coluna_Figura & Linha
Diretorio = Range("G2")
Extensao = Range("G6")

Reinicia_imagem:
On Error GoTo Tratamento1

    Do While Range(Celula).Value <> ""
    
        Range(Celula_Figura).Select
      ' Insere imagem concatenando o valor da variável "Celula" com J:\FOTOS
        ActiveSheet.Pictures.Insert(Diretorio & Range(Celula).Value & Extensao).Select
      ' Define que redimencionamento será TRANCADO - mantém proporção do tamanho
        Selection.ShapeRange.LockAspectRatio = msoTrue
      ' Define altura da imagem com 1 cm, onde uma unidade é igual a 0,35278 mm.
        Selection.ShapeRange.Height = 26.96
      ' Move a imagem para baixo
        Selection.ShapeRange.Top = Range(Celula_Figura).Top
      ' Move a imagem 0.75 unidades (0,264585 mm) para baixo
        Selection.ShapeRange.IncrementTop 0.75
      ' Move a imagem para esquerda
        Selection.ShapeRange.Left = Range(Celula_Figura).Left
      ' Move a imagem 0.75 unidades (0,264585 mm) para esquerda
        Selection.ShapeRange.IncrementLeft 0.75
      ' Sai para evitar a rotina de tratamento.
            
ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Copy
ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Delete
ActiveSheet.PasteSpecial Format:="Picture (JPEG)", Link:=False, DisplayAsIcon:=False
'Linhas de comando para gravar imagens no arquivo,
'pois no office 2010 sem estes 3 comandos cria somente um link da imagem.

        Linha = Linha + 1
        Celula = Coluna & Linha
        Coluna_Figura = Coluna_Figura
        Celula_Figura = Coluna_Figura & Linha
    Loop
        Range(Celula).Select
        Range("A1").Select
        MsgBox ("Todas as imagens inseridas com sucesso !!!")
    '
Tratamento1:
    Select Case Err.Number    ' Avalie o número do erro.
        Case 1004    ' Erro "O arquivo já está aberto".
            MsgBox ("Existe problema, ou não foi encontrada a imagem " & Range(Celula).Value & ".jpg !?!")
    End Select
End Sub

Answer 1

Sub Insere_Figura_celula()
  '
  'Macro gravada por Claiton Orth - 04/06/2013
  '
  Dim Coluna As String
  Dim Linha As Integer
  Dim Celula As String
  Dim Coluna_Figura As String
  Dim Celula_Figura As String
  Dim Caminho As String
  Dim Diretorio As String
  Dim Extensao As String
  
  Coluna = Range("G3")
  Linha = Range("G5")
  Celula = Coluna & Linha
  Coluna_Figura = Range("G4")
  Celula_Figura = Coluna_Figura & Linha
  Diretorio = Range("G2")
  Extensao = Range("G6")
  
  Do While Range(Celula).Value <> ""
    
    Range(Celula_Figura).Select
    ' Insere imagem concatenando o valor da variável "Celula" com J:\FOTOS
    Caminho = Diretorio & Range(Celula).Value & Extensao
    If Dir(Caminho) <> "" Then
      ActiveSheet.Pictures.Insert(Caminho).Select
      ' Define que redimencionamento será TRANCADO - mantém proporção do tamanho
      Selection.ShapeRange.LockAspectRatio = msoTrue
      ' Define altura da imagem com 1 cm, onde uma unidade é igual a 0,35278 mm.
      Selection.ShapeRange.Height = 26.96
      ' Move a imagem para baixo
      Selection.ShapeRange.Top = Range(Celula_Figura).Top
      ' Move a imagem 0.75 unidades (0,264585 mm) para baixo
      Selection.ShapeRange.IncrementTop 0.75
      ' Move a imagem para esquerda
      Selection.ShapeRange.Left = Range(Celula_Figura).Left
      ' Move a imagem 0.75 unidades (0,264585 mm) para esquerda
      Selection.ShapeRange.IncrementLeft 0.75
      ' Sai para evitar a rotina de tratamento.
      
      ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Copy
      ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Delete
      ActiveSheet.PasteSpecial Format:="Picture (JPEG)", Link:=False, DisplayAsIcon:=False
      'Linhas de comando para gravar imagens no arquivo,
      'pois no office 2010 sem estes 3 comandos cria somente um link da imagem.
    Else
      Range(Celula_Figura) = "<imagem não encontrada>"
    End If
    
    Linha = Linha + 1
    Celula = Coluna & Linha
    Coluna_Figura = Coluna_Figura
    Celula_Figura = Coluna_Figura & Linha
    Loop
    Range(Celula).Select
    Range("A1").Select
    MsgBox ("Todas as imagens inseridas com sucesso !!!")
    '
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Deu certo

Muito obrigado pela ajuda.

Obrigado