Este fórum está sendo desativado

[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

[gfranco]

Bom dia.
sugiro postar a sua planilha (pode retirar os dados confidenciais) para facilitar tentar ajudar.

[dcmdouglas]

Código: Selecionar todos

Sub 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

[gfranco]

Bom dia.
Postar a planilha com dados fictícios facilita a depuração do código.

[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.

[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.

[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.

[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.