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
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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 SubQualquer coisa da o grito.
Abraço
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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 SubQualquer coisa da o grito.
Abraço
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Bernardo,
Mais uma vez funcionou perfeitamente!
(Desculpa a demora em dar um retorno, estava de férias.)
Muito obrigado!!
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel