Pesquisar na Comunidade

Olá! Eu tenho um programa que sempre funcionou muitíssimo bem e esse mês ele não quis funcionar... O erro que dá é : .CurrentPage = _ "APAC" Por Favor me ajudem!!! Public strEvolMes As String Public strEvolAno As String Public strEvolYTD As String Public strEvolMat As String Public strCam As String Sub X() PROCESSO "NRC" End Sub Sub AbreArquivo() ' ActiveWorkbook.Path Workbooks.Open Filename:=ActiveWorkbook.Path & "\TEMPLATE_GD.xlsx" End Sub Sub CONEXAO2(Planilha As String, filtros As Integer, Banco As String, TABLE As String, FILTRO_GD As String) ' ' Macro1 Macro 'Provider=SQLOLEDB.1;Password=pmk-01;Persist Security Info=True;User ID=sa;Initial Catalog=CLT_ABBOTT;Data Source=s-cupbr21 '"Packet Size=4096;Use Encryption for Data=True;Tag with column collation when possible=False;Initial Catalog=" & Banco & ""), Array("""" & Banco & """.""dbo"".""" & TABLE & """"), 3 Dim SQL As String 'SQL = "SELECT top 10 * FROM `" & Replace(UCase(ArquivoMDB), ".MDB", "") & "`.TEMPLATE" SQL = "SELECT * FROM " & TABLE & " WHERE REP = '" & FILTRO_GD & "'" ' With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal) ' .Connection = _ ' "OLEDB;Provider=SQLOLEDB.1;Persist Security Info=True;Password= 101013; User ID=sa;Data Source=.;Use Procedure for Prepare=1;Auto Translate=True; Initial Catalog=" & Banco & "" ' .CommandType = xlCmdSql ' .CommandText = Array(SQL) ' .CreatePivotTable TableDestination:="R" & 7 + filtros & "C2", TableName:=Planilha, DefaultVersion:=xlPivotTableVersion12 ' End With ActiveWorkbook.Connections.Add Banco & TABLE, "" _ , Array("OLEDB;Provider=SQLOLEDB.1;Persist Security Info=True;Password=pmk-01; User ID=sa;Data Source=192.1.3.52;Use Procedure for Prepare=1;Auto Translate=True; Initial Catalog=" & Banco & ""), _ Array(SQL), xlCmdSql ' ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:=ActiveWorkbook.Connections(Banco & TABLE), Version _ ' :=xlPivotTableVersion12).CreatePivotTable TableDestination:="R" & 7 + filtros & "C2", TableName:=Planilha, DefaultVersion:=xlPivotTableVersion12 ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:=ActiveWorkbook.Connections(Banco & TABLE), Version _ :=xlPivotTableVersion12).CreatePivotTable TableDestination:="R" & 7 + filtros & "C2", TableName:=Planilha, DefaultVersion:=xlPivotTableVersion12 With ActiveSheet.PivotTables(1) .DisplayErrorString = True .ErrorString = "0" .RowGrand = False .InGridDropZones = True .ColumnGrand = False .ShowValuesRow = False .InGridDropZones = True End With End Sub Sub MontaTabela(tabelas As String, filtros As String, Valores As String, linhas As String, coluna As String) Dim TABELA As String Dim tabelaMatriz As String Dim Celula As String Dim Nome As String Dim Stilo As String Dim Size As Integer Dim CorFonte As Integer Dim CorCelula As Integer Dim avarSplit1 As Variant Dim avarSplit2 As Variant Dim avarSplit3 As Variant Dim TabelaSplit As Variant Dim FiltroSplit As Variant Dim LinhaSplit As Variant Dim ColunaSplit As Variant Dim ValoresSplit As Variant Dim tabelaAnterior As String Dim strGDGA As String Dim strBanco As String Dim strTabela As String Dim conn As ADODB.Connection Dim intIndex As Integer Dim i As Integer Set conn = New ADODB.Connection With conn .ConnectionString = "Provider=SQLOLEDB.1;Password=pmk-01;Persist Security Info=True;User ID=sa;Initial Catalog=CLT_FERRING;Data Source=192.1.3.52" .CommandTimeout = 0 .Open End With Set RS_REP = CreateObject("ADODB.Recordset") Set comm1 = CreateObject("ADODB.Command") With comm1 .CommandText = "UP_LISTA_GD" .CommandType = 4 .ActiveConnection = conn .CommandTimeout = 0 Set RS_REP = .Execute End With Do While Not RS_REP.EOF strGDGA = RS_REP(0) Call AbreArquivo tabelaAnterior = "" TabelaSplit = Split(tabelas, "|") FiltroSplit = Split(filtros, "|") ColunaSplit = Split(coluna, "|") LinhaSplit = Split(linhas, "|") ValoresSplit = Split(Valores, "|") intIndex = 0 For i = LBound(TabelaSplit) To UBound(TabelaSplit) avarSplit1 = Split(TabelaSplit(i), "#") TABELA = avarSplit1(0) If tabelaAnterior <> TABELA Then ActiveWorkbook.Sheets(TABELA).Select If intIndex = 0 Then tabelaMatriz = TABELA strBanco = avarSplit1(3) strTabela = avarSplit1(4) Rows("9:40").Select Selection.Delete Shift:=xlUp Call CONEXAO2(TABELA, avarSplit1(1) + 2, strBanco, strTabela, strGDGA) Else ActiveWorkbook.Sheets(tabelaMatriz).Rows("9:40").Copy ActiveWorkbook.Sheets(TABELA).Range("A9").Select ActiveSheet.Paste End If 'intIndex = 1 tabelaAnterior = TABELA End If Next For i = LBound(TabelaSplit) To UBound(TabelaSplit) avarSplit2 = Split(TabelaSplit(i), "#") TABELA = avarSplit2(0) If tabelaAnterior <> TABELA Then intIndex = 0 Range("a1").Select ActiveWorkbook.Sheets(TABELA).Select 'Call CONEXAO(tabela, avarSplit2(1) + 2) tabelaAnterior = TABELA End If If ColunaSplit(i) <> "" Then avarSplit2 = Split(ColunaSplit(i), "#") If avarSplit2(0) <> "" Then 'With ActiveSheet.PivotTables(tabela).PivotFields(avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(avarSplit2(0)) .Orientation = xlColumnField .Position = 1 End With ActiveSheet.PivotTables(1).InGridDropZones = False ActiveSheet.PivotTables(1).InGridDropZones = True Celula = avarSplit2(0) Nome = avarSplit2(1) Stilo = avarSplit2(2) Size = avarSplit2(3) CorFonte = avarSplit2(4) CorCelula = avarSplit2(5) FORMATO Celula, Nome, Stilo, Size, CorFonte, CorCelula End If End If If FiltroSplit(i) <> "" Then avarSplit2 = Split(FiltroSplit(i), "#") If avarSplit2(0) <> "" Then 'With ActiveSheet.PivotTables(tabela).PivotFields(avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(avarSplit2(0)) .Orientation = xlPageField .Position = 1 If avarSplit2(0) = "METRICA" Then .CurrentPage = _ "APAC" 'ElseIf avarSplit2(0) = "MOLECULA" And TABELA <> "REPORT_CNES" Then ' .CurrentPage = _ ' " TOTAL MERCADO" End If End With ActiveSheet.PivotTables(1).InGridDropZones = False ActiveSheet.PivotTables(1).InGridDropZones = True Celula = avarSplit2(0) Nome = avarSplit2(1) Stilo = avarSplit2(2) Size = avarSplit2(3) CorFonte = avarSplit2(4) CorCelula = avarSplit2(5) FORMATO Celula, Nome, Stilo, Size, CorFonte, CorCelula End If End If If LinhaSplit(i) <> "" Then avarSplit2 = Split(LinhaSplit(i), "#") If avarSplit2(0) <> "" Then 'With ActiveSheet.PivotTables(tabela).PivotFields(avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(avarSplit2(0)) .Orientation = xlRowField .Position = 1 End With ActiveSheet.PivotTables(1).InGridDropZones = False ActiveSheet.PivotTables(1).InGridDropZones = True Celula = avarSplit2(0) Nome = avarSplit2(1) Stilo = avarSplit2(2) Size = avarSplit2(3) CorFonte = avarSplit2(4) CorCelula = avarSplit2(5) FORMATO Celula, Nome, Stilo, Size, CorFonte, CorCelula End If End If If ValoresSplit(i) <> "" Then avarSplit2 = Split(ValoresSplit(i), "#") If avarSplit2(0) <> "" Then 'ActiveSheet.PivotTables(tabela).AddDataField ActiveSheet.PivotTables(tabela).PivotFields(avarSplit2(0)), " " & avarSplit2(0), xlSum ActiveSheet.PivotTables(1).AddDataField ActiveSheet.PivotTables(1).PivotFields(avarSplit2(0)), " " & avarSplit2(0), xlSum 'ActiveSheet.PivotTables(1).AddDataField ActiveSheet.PivotTables(1).PivotFields("Evol Mês"), " Evol Mês", xlSum If avarSplit2(6) = 1 Then 'With ActiveSheet.PivotTables(tabela).PivotFields(" " & avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(" " & avarSplit2(0)) .Calculation = xlPercentOfColumn .NumberFormat = "0.00%" End With ElseIf avarSplit2(6) = 0 Then 'With ActiveSheet.PivotTables(tabela).PivotFields(" " & avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(" " & avarSplit2(0)) .NumberFormat = "#,##0" End With ElseIf avarSplit2(6) = 2 Then 'With ActiveSheet.PivotTables(tabela).PivotFields(" " & avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(" " & avarSplit2(0)) .NumberFormat = "0.00%" End With ElseIf avarSplit2(6) = 3 Then 'With ActiveSheet.PivotTables(tabela).PivotFields(" " & avarSplit2(0)) With ActiveSheet.PivotTables(1).PivotFields(" " & avarSplit2(0)) .Calculation = xlPercentOfRow .NumberFormat = "0.00%" End With End If If intIndex = 1 Then 'With ActiveSheet.PivotTables(tabela).DataPivotField With ActiveSheet.PivotTables(1).DataPivotField .Orientation = xlColumnField .Position = 1 End With ActiveSheet.PivotTables(1).InGridDropZones = False ActiveSheet.PivotTables(1).InGridDropZones = True avarSplit3 = Split(ValoresSplit(i - 1), "#") Celula = avarSplit3(0) Nome = avarSplit2(1) Stilo = avarSplit2(2) Size = avarSplit2(3) CorFonte = avarSplit2(4) CorCelula = avarSplit2(5) FORMATO Celula, Nome, Stilo, Size, CorFonte, CorCelula ' FORMATO avarSplit3(0), avarSplit2(1), avarSplit2(2), avarSplit2(3), avarSplit2(4), avarSplit2(5) 'ActiveSheet.PivotTables(1).CalculatedFields("Evol Mês").StandardFormula = strEvolMes End If Celula = avarSplit2(0) Nome = avarSplit2(1) Stilo = avarSplit2(2) Size = avarSplit2(3) CorFonte = avarSplit2(4) CorCelula = avarSplit2(5) FORMATO Celula, Nome, Stilo, Size, CorFonte, CorCelula ' If avarSplit(8) <> "" Then ' With ActiveSheet.PivotTables(1).PivotFields(avarSplit(8)) ' .Orientation = xlColumnField ' .Position = 1 ' End With ' End If End If End If intIndex = intIndex + 1 Next Sheets("Capa").Select Range("A1").Select If strGDGA <> "" Then ActiveWorkbook.SaveAs Filename:=strCam & "\" & strGDGA & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close RS_REP.MOVENEXT Loop End Sub Sub FORMATO(Celula As String, Nome As String, Stilo As String, Size As Integer, CorFonte As Integer, CorCelula As Integer) On Error GoTo ERROS Cells.Find(What:=Celula, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select With Selection.Font .Name = Nome .FontStyle = Stilo .Size = Size .ColorIndex = CorFonte .ColumnGrand = False .ShowValuesRow = False .InGridDropZones = True End With With Selection.Interior .ColorIndex = CorCelula .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With Exit Sub ERROS: If Err.Number = 91 Then Exit Sub Resume Next End Sub Sub PROCESSO(SHEET As String) Dim TABELA As String Dim Banco As String Dim tabelaAnterior As String Dim NomeSheet As String Dim valor As String Dim avarSplit As Variant Dim TabelaSplit As Variant Dim filtros As String Dim LINHA As String Dim coluna As String Dim Valores As String Dim intIndex As Integer strEvolMes = Range("evolmes").Value strEvolAno = Range("EvolAno").Value strEvolYTD = Range("EvolYTD").Value strEvolMat = Range("EvolMat").Value strCam = Range("STRCAMINHO").Value Dim i As Integer For i = 2 To Sheets(SHEET).Range("A1").End(xlDown).Row If Sheets(SHEET).Range("A" & i).Value <> "" Then TABELA = TABELA & "|" & Sheets(SHEET).Range("A" & i).Value & "#" & Sheets(SHEET).Range("F" & i).Value & "##" & Sheets(SHEET).Range("j" & i).Value & "#" & Sheets(SHEET).Range("k" & i).Value 'If Ini.Range("B" & i).Value <> "" Then filtros = filtros & "|" & Trim(Sheets(SHEET).Range("B" & i).Value) & "#" & Sheets(SHEET).Range("B" & i).Font.Name & "#" & Sheets(SHEET).Range("B" & i).Font.FontStyle & "#" & Sheets(SHEET).Range("B" & i).Font.Size & "#" & Sheets(SHEET).Range("B" & i).Font.ColorIndex & "#" & Sheets(SHEET).Range("B" & i).Interior.ColorIndex 'If Ini.Range("C" & i).Value <> "" Then LINHA = LINHA & "|" & Trim(Sheets(SHEET).Range("C" & i).Value) & "#" & Sheets(SHEET).Range("c" & i).Font.Name & "#" & Sheets(SHEET).Range("c" & i).Font.FontStyle & "#" & Sheets(SHEET).Range("c" & i).Font.Size & "#" & Sheets(SHEET).Range("c" & i).Font.ColorIndex & "#" & Sheets(SHEET).Range("c" & i).Interior.ColorIndex 'If Ini.Range("D" & i).Value <> "" Then Valores = Valores & "|" & Trim(Sheets(SHEET).Range("D" & i).Value) & "#" & Sheets(SHEET).Range("d" & i).Font.Name & "#" & Sheets(SHEET).Range("d" & i).Font.FontStyle & "#" & Sheets(SHEET).Range("d" & i).Font.Size & "#" & Sheets(SHEET).Range("d" & i).Font.ColorIndex & "#" & Sheets(SHEET).Range("d" & i).Interior.ColorIndex & "#" & Sheets(SHEET).Range("E" & i).Value & "#" & Sheets(SHEET).Range("G" & i).Value & "#" & Sheets(SHEET).Range("H" & i).Value coluna = coluna & "|" & Trim(Sheets(SHEET).Range("I" & i).Value) & "#" & Sheets(SHEET).Range("I" & i).Font.Name & "#" & Sheets(SHEET).Range("I" & i).Font.FontStyle & "#" & Sheets(SHEET).Range("I" & i).Font.Size & "#" & Sheets(SHEET).Range("I" & i).Font.ColorIndex & "#" & Sheets(SHEET).Range("I" & i).Interior.ColorIndex Next TABELA = Right(TABELA, Len(TABELA) - 1) coluna = Right(coluna, Len(coluna) - 1) LINHA = Right(LINHA, Len(LINHA) - 1) Valores = Right(Valores, Len(Valores) - 1) filtros = Right(filtros, Len(filtros) - 1) Call MontaTabela(TABELA, filtros, Valores, LINHA, coluna) End Sub