Página 1 de 1
On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 07:06
por dcmdouglas
Seguinte, eu faço um goto pra ele ir para o fim do código, mostrar msgbox e sair da SUB, mas ele dá erro ao criar a tabela dinamica e ignora o Go To , alguem sabe me dizer por que ?
On Error GoTo TratarErro
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1048576C3", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet1!R1C4", TableName:="Tabela dinâmica" & numerotabela, _
DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet1").Select
On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 07:11
por gfranco
Bom dia.
sugiro postar a sua planilha (pode retirar os dados confidenciais) para facilitar tentar ajudar.
Re: On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 08:28
por dcmdouglas
Código: Selecionar todosSub test()
'On Error Resume Next
guiaDespadronizada = False
If Range("a1").Value = 1 Then
forn = "adi."
cod = "1200227696"
guia = "Plan1"
provider = "ADIENT"
ElseIf Range("a1").Value = 2 Then
forn = "and."
cod = "1200224443"
guia = "Sheet1"
provider = "ANDROID"
ElseIf Range("a1").Value = 3 Then
forn = "avm."
cod = "1200217324"
guia = "Plan1"
provider = "AVM"
ElseIf Range("a1").Value = 4 Then
forn = "aut."
cod = "1200216646"
guia = "Plan1"
provider = "AUTONEUM"
ElseIf Range("a1").Value = 5 Then
forn = "ges."
cod = "1200223271"
guia = "Plan1"
guiaDespadronizada = True
provider = "GESTAMP"
ElseIf Range("a1").Value = 6 Then
forn = "goo."
cod = "1200200656"
guia = "Sheet1"
provider = "GOODYEAR"
ElseIf Range("a1").Value = 14 Then
forn = "fau."
cod = "1200224840"
guia = "Plan1"
provider = "FAURECIA"
ElseIf Range("a1").Value = 13 Then
forn = "ipa."
cod = "1200200863"
guia = "Plan1"
provider = "IPA"
ElseIf Range("a1").Value = 7 Then
forn = "iny."
cod = "1200201942"
guia = "Sheet1"
guiaDespadronizada = True
provider = "INYLBRA"
ElseIf Range("a1").Value = 8 Then
forn = "pel."
cod = "1200207633"
guia = "Plan1"
provider = "PELZER"
ElseIf Range("a1").Value = 9 Then
forn = "sai."
cod = "1200219764"
guia = "Sheet1"
provider = "SAINT GOBAIN"
ElseIf Range("a1").Value = 10 Then
forn = "sog."
cod = "1200207140"
guia = "Planilha1"
provider = "SOGEFI"
ElseIf Range("a1").Value = 11 Then
forn = "ti."
cod = "1200206837"
guia = "Plan1"
provider = "TI"
ElseIf Range("a1").Value = 12 Then
forn = "cont."
cod = "1200203459"
guia = "Plan1"
provider = "CONTINENTAL"
Else
MsgBox ("Foi digitado valor indevido na celula que está vinculada aos botões SelectBox")
Exit Sub
End If
Dim contErros As Integer
contErros = 0
forne = forn 'salva o nome inicial pra poder recuperar só a primeira parte depois
formato:
contErros = contErros + 1
If contErros = 1 Then
forn = forne & "xls"
ElseIf contErros = 2 Then
forn = forne & "xlsx"
ElseIf contErros = 3 Then
forn = forne & "csv"
ElseIf contErros = 4 Then
forn = forne & "xlsm"
Else
MsgBox (contErros & forn)
MsgBox ("Planilha não está salva na pasta do programa, está salva com nome errado ou salva com formato não reconhecido.")
Exit Sub
End If
'csv
'MsgBox (forn)
On Error GoTo formato
Set sumD = GetObject(ThisWorkbook.Path & "\" & forn)
'If guiaDespadronizada = True Then
guia = sumD.ActiveSheet.Name
'End If
Set sumSap = GetObject(ThisWorkbook.Path & "\export.XLSX")
Set calendario = GetObject(ThisWorkbook.Path & "\calendar.xlsm")
Windows("export.xlsx").Activate
Columns("A:C").Select
'CRIA A TABELA DINÂMICA
numerotabela = Range("aa1").Value + 1
Columns("A:C").Select
On Error GoTo error2
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1048576C3", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet1!R1C4", TableName:="Tabela dinâmica" & numerotabela, _
DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet1").Select
Cells(1, 4).Select
With ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).PivotFields("Fornecedor")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).PivotFields("Material")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).AddDataField ActiveSheet. _
PivotTables("Tabela dinâmica" & numerotabela).PivotFields("Quantidade"), _
"Contagem de Quantidade", xlCount
With ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).PivotFields( _
"Contagem de Quantidade")
.Caption = "SAP"
.Function = xlSum
End With
ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).PivotFields("Fornecedor"). _
ClearAllFilters
On Error GoTo error1
ActiveSheet.PivotTables("Tabela dinâmica" & numerotabela).PivotFields("Fornecedor"). _
CurrentPage = cod
ActiveSheet.PivotTables(numerotabela).ColumnGrand = False
Range("f1").Value = "FORN"
Range("g1").Value = "DIFERENÇA"
lin = 4
Do
'Range("p" & lin).Value = "=VLOOKUP(RC[-2],C[-14]:C[-12],3,FALSE)"
' Range("q" & lin).Value = Range("l" & lin).Value
'MsgBox (forn & " " & guia)
Range("f" & lin).Activate
'ActiveCell.FormulaR1C1 = "=SUMIF('[and.xlsx]Sheet1'!C1:C5,RC[-2],'[and.xlsx]Sheet1'!C5)/1000"
ActiveCell.FormulaR1C1 = "=SUMIF('[" & forn & "]" & guia & "'!C1:C5,RC[-2],'[" & forn & "]" & guia & "'!C5)/1000"
'"=SUMIF('[ges.xlsx]RELATORIO-12.06.2017'!C1:C5,RC[-2],'[ges.xlsx]RELATORIO-12.06.2017'!C5)"
Range("g" & lin).Value = Range("e" & lin).Value - Range("f" & lin).Value
lin = lin + 1
Loop While (Not IsEmpty(Range("d" & lin).Value))
MsgBox ("Feito!")
Range("aa1").Value = Range("aa1").Value + 1
Call formatacaoCondicional
Dim resposta As Date
resp = MsgBox("Data da produção é " & Date - 1 & " ?", vbYesNo, "Produção do dia")
If resp = vbNo Then
resposta = InputBox("Digite a data da produção que está verificando: " & vbNewLine & "Exemplo: 01/01/2017")
Else
resposta = Date - 1
End If
linha = 2
colum = 3
Do
If Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, 1).Value = resposta Then
'MsgBox linha
Exit Do
Else
linha = linha + 1
End If
Loop While (Not IsEmpty(Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, 1).Value))
Do
If Workbooks("calendar.xlsm").Sheets("calendar").Cells(1, colum).Value = provider Then
'MsgBox colum
Exit Do
Else
colum = colum + 1
End If
Loop While (Not IsEmpty(Workbooks("calendar.xlsm").Sheets("calendar").Cells(1, colum).Value))
controle = MsgBox("Há alguma divergência no relatório ?", vbYesNo, "Salvando...")
If controle = vbYes Then
Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, colum).Value = "DIV"
Else
Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, colum).Value = "OKK"
End If
Columns("F:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("a1").Select
sumD.Close False
coment = MsgBox("Deseja adicionar um comentário? ", vbYesNo, "Adicionar Comentário")
If coment = vbYes Then
Dim comentario As String
comentario = InputBox("Digite um comentário: ")
'Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, colum).Comment.Visible = False
With Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, colum)
.ClearComments
.AddComment
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Text Text:=comentario
End With
'Workbooks("calendar.xlsm").Sheets("calendar").Cells(linha, colum).Comment.Text Text:=Chr(10) & comentario & Chr(10) & ""
End If
calendario.Close True
Exit Sub
error1:
MsgBox ("Não há recebimento no SAP deste fornecedor neste relatório 'Export' salvo na pasta.")
Exit Sub
error2:
MsgBox ("Você precisa fechar a planilha 'export.xlsx' antes de rodar a macro para outro fornecedor, pois uma planilha dinamica não pode sobrepor outra")
Exit Sub
End Sub
On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 08:52
por gfranco
Bom dia.
Postar a planilha com dados fictícios facilita a depuração do código.
On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 09:14
por wesleyribeiro123
Brother
Bom dia,
Uma dúvida aqui, o erro dá no Goto error2 ou no Goto error1?
Te aconselho a usar um On Error Goto 0 para desligar a tratativa de erro antes de iniciar o Goto error1, ou seja ele inicia o Goto error2, desliga a tratativa com Goto 0 e aciona a nova tratativa do Goto error1 e no final coloque novamente o Goto 0 para que o VBA entenda o trecho ao qual a tratativa estará ativa.
Não sei se apenas isso vai solucionar teu problema, mas acredito que é um passo a começar analisar quanto ao erro mencionado.
Espero ter contribuido com algo.
Re: On Error Goto não funciona!!!
Enviado: 11 Out 2017 às 14:39
por babdallas
Primeiro você usa um On error Resume Next. Logo, antes de usar o On Error Goto, use o On Error goto 0 ou Err.clear.
On Error Goto não funciona!!!
Enviado: 17 Out 2017 às 07:51
por wesleyribeiro123
Mas pelo que pude observar o uso do On Error Resume Next não seria ideal, pois ele pula a linha do código com erro e executa a próxima linha.
No exemplo de nosso amigo, aparentemente ele quer que ao identificar o erro a execução seja direcionada a uma tratativa do erro.
Re: On Error Goto não funciona!!!
Enviado: 17 Out 2017 às 07:59
por babdallas
Com certeza Wesley! Não vejo porque ele usar o On Error Resume Next neste caso.
Eu não sou um grande programador, longe disso, mas evito ao máximo usar o On Error Resume Next. Quando uso, é para uma linha específica do código que sei que vai dar erro. Mas logo depois já uso o ON Error Goto 0 ou Err.clear. Mas em geral uso On Error Goto para tratamento de erros.