Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pular para próxima ...
 
Notifications
Clear all

Pular para próxima macro se der erro

 
2024 - VBA & Macros
4 Posts
2 Usuários
0 Reactions
899 Visualizações
RSS
 Zgoda
(@zgoda)
Posts: 0
New Member
Topic starter
 

Uso o seguinte código para puxar imagens de uma pasta no pc.

Sub Macros()

Call Imagem1
Call Imagem2
Call Imagem3

End Sub

Sub Imagem1()

Range("A2").Select 'This is where picture will be inserted
Dim picname As String
picname = Range("F2")  'This is the picture name
ActiveSheet.Pictures.Insert("C:fotos" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("A2").Left
.Top = Range("A2").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 200#
.ShapeRange.Width = 265#
.ShapeRange.Rotation = 0#
End With

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub

Sub Imagem2()

Range("A3").Select 'This is where picture will be inserted
Dim picname As String
picname = Range("F3")  'This is the picture name
ActiveSheet.Pictures.Insert("C:fotos" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("A3").Left
.Top = Range("A3").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 200#
.ShapeRange.Width = 265#
.ShapeRange.Rotation = 0#
End With

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub

Sub Imagem3()

Range("A4").Select 'This is where picture will be inserted
Dim picname As String
picname = Range("F4")  'This is the picture name
ActiveSheet.Pictures.Insert("C:fotos" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("A4").Left
.Top = Range("A4").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 200#
.ShapeRange.Width = 265#
.ShapeRange.Rotation = 0#
End With

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub

Queria saber como faço para caso o "Call Imagem2" dê algum erro, como pela inexistência da imagem na fonte ele passar e executar a próxima macro no caso a "Call Imagem3".

Atualmente ele aparece uma janela de erro e não continua, daí eu tenho q criar na mão uma imagem vazia no paint. o problema é q essa minha planilha já tem mais de 8 mil imagens.

 
Postado : 08/05/2015 11:28 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim:

Sub CarregaImg()
Dim picname As String
Dim x As Integer
For x = 2 To 4
picname = Range("F" & x) 'This is the picture name

If Dir("C:fotos" & picname & ".jpg") <> "" Then

    Range("A" & x).Select 'This is where picture will be inserted
    'picname = Range("F2")  'This is the picture name
    ActiveSheet.Pictures.Insert("C:fotos" & picname & ".jpg").Select 'Path to where pictures are stored
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This resizes the picture
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With Selection
            .Left = Range("A2").Left
            .Top = Range("A2").Top
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 200#
            .ShapeRange.Width = 265#
            .ShapeRange.Rotation = 0#
        End With
    
    Range("A10").Select
    Application.ScreenUpdating = True
 Else
    MsgBox "Foto " & picname & " não encontrada"
 End If
Next
End Sub
 
Postado : 08/05/2015 11:43 am
 Zgoda
(@zgoda)
Posts: 0
New Member
Topic starter
 

E como faço para substituir isso aqui:

Código.zip
 
Postado : 08/05/2015 12:08 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 
Sub CarregaImg()
Dim picname As String
Dim x As Integer
Dim lastRow As Integer
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 2 To lastRow
picname = Range("F" & x) 'This is the picture name

If Dir("C:fotos" & picname & ".jpg") <> "" Then

    Range("A" & x).Select 'This is where picture will be inserted
    'picname = Range("F2")  'This is the picture name
    ActiveSheet.Pictures.Insert("C:fotos" & picname & ".jpg").Select 'Path to where pictures are stored
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This resizes the picture
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With Selection
            .Left = Range("A2").Left
            .Top = Range("A2").Top
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 200#
            .ShapeRange.Width = 265#
            .ShapeRange.Rotation = 0#
        End With
    
    Range("A10").Select
    Application.ScreenUpdating = True
Else
    MsgBox "Foto " & picname & " não encontrada"
End If
Next
End Sub
 
Postado : 08/05/2015 2:35 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico