none
Erro ao Gerar a Tabela dinâmica no VBA RRS feed

  • Pergunta

  • Olá Pessoal, bom dia!

    Quando altero o o valor do caminho "Plan1.TextBox2.Value" para buscar o arquivo de banco de dados para gerar a tabela dinâmica dá erro

    Segue abaixo o código.

    Desde já muito obrigado.

    Sub Tabela_Dinamica()
    Dim resultado
    Dim resultado2
    Dim i As Long
    Dim arq_nome As String
    On Error GoTo trataErro
    caminho = Plan1.TextBox2.Value
    arq_nome = Plan1.TextBox2.Value
    For i = 1 To Len(arq_nome)
        If Left(Right(arq_nome, i), 1) = "\" Then
            arq_nome = Right(arq_nome, i - 1)
         Exit For
        End If
    Next i
    arq_nome = Left(arq_nome, InStr(arq_nome, ".mdb") - 1)
        If Plan1.TextBox2.Value = "" Then
            MsgBox ("Informe o caminho!")
        Else
        resultado = MsgBox("Deseja criar a Tabela Dinâmica?", vbYesNo, "Atenção!!!")
        If resultado = vbYes Then
        
        Sheets("tab_din").Cells.ClearContents
        
        Sheets("tab_din").Select
        Range("A7").Select
        Workbooks("Completo.xlsm").Connections.Add arq_nome, "", Array( _
            "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\BancoDados\HK_data_.mdb;Mode=Share Deny Write;E" _
            , _
            "xtended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty" _
            , _
            "pe=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Da" _
            , _
            "tabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compac" _
            , _
            "t=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
            ), Array("CONSULTA"), 3
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ActiveWorkbook.Connections(arq_nome), Version:=xlPivotTableVersion12 _
        ).CreatePivotTable TableDestination:="tab_din!R7C1", TableName:= _
            "Tabela dinâmica1", DefaultVersion:=xlPivotTableVersion12
        Cells(7, 1).Select
        With ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("Tabela")
            .Orientation = xlRowField
            .Position = 1
        End With
        
        ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
            PivotTables("Tabela dinâmica1").PivotFields("Número_Cartão"), _
            "Contar de Número_Cartão", xlCount
        ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
            PivotTables("Tabela dinâmica1").PivotFields("Valor"), "Soma de Valor", xlSum
            MsgBox ("Tabela Dinâmica criada com sucesso!")
        End If
    End If
    Exit Sub
    trataErro:
        MsgBox "Error...", vbCritical, "Erro."
    End Sub

    quarta-feira, 19 de setembro de 2012 13:46

Respostas

  • Verifique se o código abaixo funciona. A única linha que alterei está em negrito:

    Sub Tabela_Dinamica()
        Dim resultado
        Dim resultado2
        Dim i As Long
        Dim arq_nome As String
        Dim caminho As String
        On Error GoTo trataErro
        caminho = Plan1.TextBox2.Value
        arq_nome = Plan1.TextBox2.Value
        For i = 1 To Len(arq_nome)
            If Left(Right(arq_nome, i), 1) = "\" Then
                arq_nome = Right(arq_nome, i - 1)
                Exit For
            End If
        Next i
        arq_nome = Left(arq_nome, InStr(arq_nome, ".mdb") - 1)
        If Plan1.TextBox2.Value = "" Then
            MsgBox ("Informe o caminho!")
        Else
            resultado = MsgBox("Deseja criar a Tabela Dinâmica?", vbYesNo, "Atenção!!!")
            If resultado = vbYes Then
    
                Sheets("tab_din").Cells.ClearContents
    
                Sheets("tab_din").Select
                Range("A7").Select
                Workbooks("Completo.xlsm").Connections.Add arq_nome, "", Array( _
                  "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & caminho & ";Mode=Share Deny Write;E", _
                  "xtended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty", _
                  "pe=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Da", _
                  "tabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compac", _
                  "t=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False"), Array("CONSULTA"), 3
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:=ActiveWorkbook.Connections(arq_nome), Version:=xlPivotTableVersion12 _
                  ).CreatePivotTable TableDestination:="tab_din!R7C1", TableName:="Tabela dinâmica1", DefaultVersion:=xlPivotTableVersion12
                Cells(7, 1).Select
                With ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("Tabela")
                    .Orientation = xlRowField
                    .Position = 1
                End With
    
                ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
                  PivotTables("Tabela dinâmica1").PivotFields("Número_Cartão"), _
                  "Contar de Número_Cartão", xlCount
                ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
                  PivotTables("Tabela dinâmica1").PivotFields("Valor"), "Soma de Valor", xlSum
                MsgBox ("Tabela Dinâmica criada com sucesso!")
            End If
        End If
        Exit Sub
    trataErro:
        MsgBox "Error...", vbCritical, "Erro."
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 20 de setembro de 2012 21:07
    Moderador

Todas as Respostas

  • Esse código já funcionou alguma vez com algum caminho de arquivo?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 19 de setembro de 2012 23:32
    Moderador
  • Olá Felipe!

    Desde já muito obrigado pela a atenção....

    Sim, ele já funcionou, mas só com um caminho.... qualquer outro não dá certo.

    Valeu...

    quinta-feira, 20 de setembro de 2012 03:24
  • Digite aqui com qual caminho ele funciona e com qual caminho ele não funciona.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 20 de setembro de 2012 10:19
    Moderador
  • Caminho OK - C:\BancoDados\HK_data_.mdb

    Qualquer outro caminho não funciona... exemplo C:\BancoDados\HK_02.08.2012_.mdb

    Obrigado.

    quinta-feira, 20 de setembro de 2012 14:17
  • Verifique se o código abaixo funciona. A única linha que alterei está em negrito:

    Sub Tabela_Dinamica()
        Dim resultado
        Dim resultado2
        Dim i As Long
        Dim arq_nome As String
        Dim caminho As String
        On Error GoTo trataErro
        caminho = Plan1.TextBox2.Value
        arq_nome = Plan1.TextBox2.Value
        For i = 1 To Len(arq_nome)
            If Left(Right(arq_nome, i), 1) = "\" Then
                arq_nome = Right(arq_nome, i - 1)
                Exit For
            End If
        Next i
        arq_nome = Left(arq_nome, InStr(arq_nome, ".mdb") - 1)
        If Plan1.TextBox2.Value = "" Then
            MsgBox ("Informe o caminho!")
        Else
            resultado = MsgBox("Deseja criar a Tabela Dinâmica?", vbYesNo, "Atenção!!!")
            If resultado = vbYes Then
    
                Sheets("tab_din").Cells.ClearContents
    
                Sheets("tab_din").Select
                Range("A7").Select
                Workbooks("Completo.xlsm").Connections.Add arq_nome, "", Array( _
                  "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & caminho & ";Mode=Share Deny Write;E", _
                  "xtended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty", _
                  "pe=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Da", _
                  "tabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compac", _
                  "t=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False"), Array("CONSULTA"), 3
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:=ActiveWorkbook.Connections(arq_nome), Version:=xlPivotTableVersion12 _
                  ).CreatePivotTable TableDestination:="tab_din!R7C1", TableName:="Tabela dinâmica1", DefaultVersion:=xlPivotTableVersion12
                Cells(7, 1).Select
                With ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("Tabela")
                    .Orientation = xlRowField
                    .Position = 1
                End With
    
                ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
                  PivotTables("Tabela dinâmica1").PivotFields("Número_Cartão"), _
                  "Contar de Número_Cartão", xlCount
                ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
                  PivotTables("Tabela dinâmica1").PivotFields("Valor"), "Soma de Valor", xlSum
                MsgBox ("Tabela Dinâmica criada com sucesso!")
            End If
        End If
        Exit Sub
    trataErro:
        MsgBox "Error...", vbCritical, "Erro."
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 20 de setembro de 2012 21:07
    Moderador