Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Tratamento de erro ...
 
Notifications
Clear all

Tratamento de erro em macro

 
2024 - VBA & Macros
Post Recente por Wagner Morel 10 anos atrás
2 Posts
2 Usuários
0 Reactions
723 Visualizações
RSS
 Miguexcel
(@miguexcel)
Posts: 167
Estimable Member
Topic starter
 

Boa tarde,

Tenho o seguinte código que abre arquivos e vai atualizando o conteúdo com base noutros arquivos. O problema é que por vezes, arquivos que não existem e gostaria de tratar esse erro e que a macro passasse automaticamente para outra região sem rodar o resto do código. Ou seja, se não for detetado o arquivo: W_Região_Norte, queria que a macro não desse erro e passasse para o código da Região 2.

Alguém me consegue ajudar?

Obrigado.

Option Explicit
Sub JuntarFicheiros3()
    Dim sh As Worksheet
    Dim owbk As Workbook
    Dim sht As Worksheet
        
    Application.DisplayAlerts = False
    Application.ScreenUpdating = 0
    
'Região 1

    Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKREGIÃOFINALW_Região1")
    Set sh = ActiveSheet
    
    Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKRegião_OrigemORIGEMW_Região_Norte")
        Range("A2", Range("AM" & Rows.Count).End(xlUp)).Copy
        sh.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        owbk.Close False
        
        Range("A1").Select
        
        ActiveWorkbook.Save
        ActiveWorkbook.Close False

'Região 2
    
    'Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKREGIÃOFINALW_Região1")
    'Set sh = ActiveSheet
    
    'Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKRegião_OrigemDESTINOW_Região_Norte")
        'Range("A2", Range("AM" & Rows.Count).End(xlUp)).Copy
        'sh.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        'owbk.Close False
                  
        'Range("A1").Select
        
        'ActiveWorkbook.Save
        'ActiveWorkbook.Close False

 Application.ScreenUpdating = 1
 
Postado : 21/05/2015 9:18 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Miguexcel,

Boa Tarde!

Você deve verificar, antes do código que executa as rotinas que você quer, se o arquivo existe, algo como isto:

Function VerificandoSeArquivoExiste(Arquivo As String) As Boolean
    
    If Dir(Arquivo) <> "" Then
        VerificandoSeArquivoExiste = True
    Else
        VerificandoSeArquivoExiste = False
    End If
End Function


Sub JuntarFicheiros3()
    Dim sh As Worksheet
    Dim owbk As Workbook
    Dim sht As Worksheet
       
    Application.DisplayAlerts = False
    Application.ScreenUpdating = 0
   
'Região 1
    Dim Arq As String
    Arq = ActiveWorkbook.Path & "MAGIC_TRICKREGIÃOFINALW_Região1.xlsx"

    If VerificandoSeArquivoExiste(Arq) = True Then

              Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKREGIÃOFINALW_Região1")
              Set sh = ActiveSheet
   
              Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKRegião_OrigemORIGEMW_Região_Norte")
              Range("A2", Range("AM" & Rows.Count).End(xlUp)).Copy
              sh.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
              owbk.Close False
       
              Range("A1").Select
       
              ActiveWorkbook.Save
              ActiveWorkbook.Close False
    End If

'Região 2

    Dim Arq As String
    Arq = ActiveWorkbook.Path & "MAGIC_TRICKRegião_OrigemDESTINOW_Região_Norte.xlsx"

    If VerificandoSeArquivoExiste(Arq) = True Then

              'Set owbk = Workbooks.Open("D:Usersp054515DesktopMAGIC_TRICKRegião_OrigemDESTINOW_Região_Norte")
               'Range("A2", Range("AM" & Rows.Count).End(xlUp)).Copy
               'sh.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
               'owbk.Close False
                 
                'Range("A1").Select
       
               'ActiveWorkbook.Save
               'ActiveWorkbook.Close False

               Application.ScreenUpdating = 1
     End If

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 21/05/2015 11:44 am
Forum Jump:
  Tópico Anterior
Próximo Tópico