Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Erro em funções &qu...
 
Notifications
Clear all

Erro em funções "On Error GoTo" consecutivas

 
2024 - VBA & Macros
8 Posts
2 Usuários
0 Reactions
1,037 Visualizações
RSS
 fcaoll89
(@fcaoll89)
Posts: 0
New Member
Topic starter
 

Bom dia,

Estou com um problema em uma função, já tentei diversas dicas, mas não consigo resolver.
Basicamente meu interesse consiste em salvar um PDF em apenas uma de três pastas possíveis. Se uma pasta der erro, por qualquer motivo, quero que a função tente salvar na próxima opção. Estou usando a função On Error GoTo para saltar em caso de erro, mas na segunda pasta é como se a função não funcionasse. Não entendo o porquê. Será que alguém poderia me ajudar, por favor? Desde já muito obrigado!

Sub SalvarPDF()

Application.ScreenUpdating = False

Sheets("AF Dia").Select
Calculate

    Dim ks As Worksheet
    Set ks = Worksheets("BD GERAL")
    
    Dim Nome
    Nome = ks.Range("B77").Value

    Dim Caminho1
    Caminho1 = "C:UsersusuarioPasta1"
On Error GoTo Next1
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho1 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub

Next1:
    Dim Caminho2
    Caminho2 = "C:UsersusuarioPasta2"
On Error GoTo Next2
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho2 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub
    
Next2:
    Dim Caminho3
    Caminho3 = ActiveWorkbook.Path
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho3 + "FdC Realizado - " + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
        
End Sub
 
Postado : 20/03/2016 10:22 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia fcaoll89,

Tenta assim:

Sub SalvarPDF()

On Error Resume Next

Application.ScreenUpdating = False

Sheets("AF Dia").Select
Calculate

    Dim ks As Worksheet
    Set ks = Worksheets("BD GERAL")
    
    Dim Nome
    Nome = ks.Range("B77").Value

    Dim Caminho1
    Caminho1 = "C:UsersusuarioPasta1"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho1 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub

Next1:
    Dim Caminho2
    Caminho2 = "C:UsersusuarioPasta2"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho2 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub
    
Next2:
    Dim Caminho3
    Caminho3 = ActiveWorkbook.Path
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho3 + "FdC Realizado - " + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
        
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 21/03/2016 5:47 am
 fcaoll89
(@fcaoll89)
Posts: 0
New Member
Topic starter
 

Bom dia, Bernardo

Obrigado pela resposta.
Não entendi sua sugestão, mas apliquei e não funcionou.
Fiz um teste considerando que ele daria erro na primeira pasta, mas acontece que ele ativa a Exit Sub e não tenta salvar nas demais pastas.

Explicando melhor meu objetivo:
Tenho 3 opções de pastas para salvar o arquivo, gostaria que a rotina tentasse salvar na primeira e, não conseguindo, tentasse salvar na segunda e, mais uma vez, não conseguindo, tentasse salvar na terceira (que como é a ActiveWorkbook.Path, sempre vai funcionar). Mas quero que, caso consiga salvar na primeira ou segunda, que encerre a rotina, caso contrário ela vai salvar um arquivo em cada uma das pastas o que não será necessário.

Qualquer dúvida, tento explicar de um jeito diferente.
Obrigado.

Bom dia fcaoll89,

Tenta assim:

Sub SalvarPDF()

On Error Resume Next

Application.ScreenUpdating = False

Sheets("AF Dia").Select
Calculate

    Dim ks As Worksheet
    Set ks = Worksheets("BD GERAL")
    
    Dim Nome
    Nome = ks.Range("B77").Value

    Dim Caminho1
    Caminho1 = "C:UsersusuarioPasta1"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho1 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub

Next1:
    Dim Caminho2
    Caminho2 = "C:UsersusuarioPasta2"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho2 + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
    Exit Sub
    
Next2:
    Dim Caminho3
    Caminho3 = ActiveWorkbook.Path
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho3 + "FdC Realizado - " + Nome + ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
        
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 22/03/2016 5:54 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

fcaoll89,

Tenta assim:

Option Explicit
Dim QuantTentativa As Long

Sub SalvarPDF()

    Application.ScreenUpdating = False
    
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta1")
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta2")
    If QuantTentativa = 0 Then Call Tentativa(ActiveWorkbook.Path & "FdC Realizado - ")

    QuantTentativa = 0
    Application.ScreenUpdating = True
    
End Sub

Private Sub Tentativa(ByVal Caminho As String)
Dim Nome    As String
On Error GoTo Quant
    
    Nome = Worksheets("AF Dia").Range("B77").Value
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho & Nome & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    QuantTentativa = QuantTentativa + 1
    
Exit Sub
Quant:
QuantTentativa = 0
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 22/03/2016 8:09 am
 fcaoll89
(@fcaoll89)
Posts: 0
New Member
Topic starter
 

Bernardo!

Cara muito obrigado, solução TOP! Resolveu 100%.
Uma dúvida, na hipótese distante das três pastas derem errado tentei colocar uma mensagem de erro após a exit sub, mas a mensage box repete 3 vezes quando dou "ok".
Você saberia me ajudar a resolver isso?

Mais uma vez obrigado!!

fcaoll89,

Tenta assim:

Option Explicit
Dim QuantTentativa As Long

Sub SalvarPDF()

    Application.ScreenUpdating = False
    
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta1")
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta2")
    If QuantTentativa = 0 Then Call Tentativa(ActiveWorkbook.Path & "FdC Realizado - ")

    QuantTentativa = 0
    Application.ScreenUpdating = True
    
End Sub

Private Sub Tentativa(ByVal Caminho As String)
Dim Nome    As String
On Error GoTo Quant
    
    Nome = Worksheets("AF Dia").Range("B77").Value
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho & Nome & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    QuantTentativa = QuantTentativa + 1
    
Exit Sub
Quant:
QuantTentativa = 0
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 22/03/2016 7:07 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia fcaoll89,

Cara, pode somente apresentar a mensagem de erro após a última tentativa:

Option Explicit
Dim QuantTentativa As Long

Sub SalvarPDF()

    Application.ScreenUpdating = False
    
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta1")
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta2")
    If QuantTentativa = 0 Then Call Tentativa(ActiveWorkbook.Path & "FdC Realizado - ")
    If QuantTentativa = 0 Then MsgBox "Ocorreu um erro ao tentar salvar o arquivo"
    
    QuantTentativa = 0
    Application.ScreenUpdating = True
    
End Sub

Private Sub Tentativa(ByVal Caminho As String)
Dim Nome    As String
On Error GoTo Quant
    
    Nome = Worksheets("AF Dia").Range("B77").Value
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho & Nome & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    MsgBox "Arquivo salvo com sucesso." & vbNewLine & vbNewLine & Caminho & Nome & ".pdf"
    QuantTentativa = QuantTentativa + 1
    
Exit Sub
Quant:
QuantTentativa = 0
End Sub

Ou ao dar erro após última tentativa, aparecer a caixa de diálogo solicitando ao usuário a selecionar uma pasta de sua escolha:

Option Explicit
Dim QuantTentativa As Long

Sub SalvarPDF()
Dim fDlg                As FileDialog

    Application.ScreenUpdating = False
    
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta1")
    If QuantTentativa = 0 Then Call Tentativa("C:UsersusuarioPasta2")
    If QuantTentativa = 0 Then Call Tentativa(ActiveWorkbook.Path & "FdC Realizado - ")
    
    If QuantTentativa > 0 Then GoTo final
    
    MsgBox "Ocorreu um erro ao tentar salvar o arquivo" & vbNewLine & "Selecione uma pasta para salvar o arquivo."
    
    Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogFolderPicker)
    
    If fDlg.Show = -1 Then
        Call Tentativa(fDlg.SelectedItems(1) & "")
    Else
        MsgBox "Não foi selecionada nenhuma pasta"
        GoTo final
    End If

    Set fDlg = Nothing

final:
    QuantTentativa = 0
    Application.ScreenUpdating = True
    
End Sub

Private Sub Tentativa(ByVal Caminho As String)
Dim Nome    As String
On Error GoTo Quant
    
    Nome = Worksheets("AF Dia").Range("B77").Value
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Caminho & Nome & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    MsgBox "Arquivo salvo com sucesso." & vbNewLine & vbNewLine & Caminho & Nome & ".pdf"
    QuantTentativa = QuantTentativa + 1
    
Exit Sub
Quant:
QuantTentativa = 0
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 23/03/2016 6:12 am
 fcaoll89
(@fcaoll89)
Posts: 0
New Member
Topic starter
 

Bernardo,

Mais uma vez funcionou perfeitamente!
(Desculpa a demora em dar um retorno, estava de férias.)

Muito obrigado!!

 
Postado : 28/03/2016 7:29 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

;)

 
Postado : 30/03/2016 8:15 am
Forum Jump:
  Tópico Anterior
Próximo Tópico