Jump to content
Fórum Script Brasil

Search the Community

Showing results for tags 'vbaerro'.

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • Programação & Desenvolvimento
    • ASP
    • PHP
    • .NET
    • Java
    • C, C++
    • Delphi, Kylix
    • Lógica de Programação
    • Mobile
    • Visual Basic
    • Outras Linguagens de Programação
  • WEB
    • HTML, XHTML, CSS
    • Ajax, JavaScript, XML, DOM
    • Editores
  • Arte & Design
    • Corel Draw
    • Fireworks
    • Flash & ActionScript
    • Photoshop
    • Outros Programas de Arte e Design
  • Sistemas Operacionais
    • Microsoft Windows
    • GNU/Linux
    • Outros Sistemas Operacionais
  • Softwares, Hardwares e Redes
    • Microsoft Office
    • Softwares Livres
    • Outros Softwares
    • Hardware
    • Redes
  • Banco de Dados
    • Access
    • MySQL
    • PostgreSQL
    • SQL Server
    • Demais Bancos
  • Segurança e Malwares
    • Segurança
    • Remoção De Malwares
  • Empregos
    • Vagas Efetivas
    • Vagas para Estágios
    • Oportunidades para Freelances
  • Negócios & Oportunidades
    • Classificados & Serviços
    • Eventos
  • Geral
    • Avaliações de Trabalhos
    • Links
    • Outros Assuntos
    • Entretenimento
  • Script Brasil
    • Novidades e Anúncios Script Brasil
    • Mercado Livre / Mercado Sócios
    • Sugestões e Críticas
    • Apresentações

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

Joined

  • Start

    End


Group


AIM


MSN


Website URL


ICQ


Yahoo


Jabber


Skype


Location


Interests

Found 4 results

  1. Olá pessoal, tudo bem? Tenho uma planilha com macros para tratamento de dados e está habilitada para macros, porém, acontece um bug que ela simplesmente some com todos os códigos e não deixa salvar a plan. Aparecendo os erros abaixo e quando dou atl+F11 os módulos estão em branco. Já aconteceram 3x com planilhas diferentes. Ela funciona por um período e do Nada acontece esse erro. uso ela todos os dias para atualizar as bases de dados. Alguém já passou por um problema semelhante? Vlw, pessoal.
  2. Rafa23_ms

    Feriado da pascoa

    Bom dia, sei que a função Floor(Day(Minute(ano_inicial / 38) / 2 + 56) & "/5" & "/" & ano_inicial, 7) - 34 funciona na plhanilha mas quando tento executar ela no excel da erro de #VALOR!, não sei resolver. Public Function pascoa(ByVal data_inicial As Date, ByVal data_final As Date) As Date ano_inicial = Year(data_inicial) pascoa = WorksheetFunction.Floor(Day(Minute(ano_inicial / 38) / 2 + 56) & "/5" & "/" & ano_inicial, 7) - 34 End Function
  3. Bom dia, estou tentando fazer uma function que pega como parâmetro duas datas e retorna os dias uteis desse período, entretanto não consigo entender o que estou fazendo de errado 'retorna os dias uteis Public Function DiasUteis(ByVal data_inicial As Date, ByVal data_final As Date) As Integer Ano_inicial = Year(data_inicial) Ano_final = Year(data_final) Aux = 0 Corridos = WorksheetFunction.NetworkDays(data_inicial, data_final) Feriados = 0 While Aux <= Ano_final If Aux = 0 Then Aux = Ano_inicial End If pascoa = WorksheetFunction.Floor(Day(Minute(Aux / 38) / 2 + 56) & "/5" & "/" & Aux, 7) - 34 pascoa = CDate(pascoa) Carnaval1 = CDate(pascoa - 48) Calnaval2 = CDate(canaval1 + 1) Paixao = CDate(pascoa - 2) Corpo = CDate(pascoa + 60) tiradentes = WorksheetFunction.Date(Aux, 4, 21) confraternizacao = WorksheetFunction.Date(Aux, 1, 1) Trabalho = WorksheetFunction.Date(Aux, 5, 1) Independencia = WorksheetFunction.Date(Aux, 9, 7) Senhora = WorksheetFunction.Date(Aux, 10, 12) Finados = WorksheetFunction.Date(Aux, 11, 2) proclamacao = WorksheetFunction.Date(Aux, 11, 15) Natal = WorksheetFunction.Date(Aux, 12, 25) If pascoa > data_inicial Then If pascoa < data_final Then Feriados = Feriados + 1 End If End If If pascoa > data_inicial Then If pascoa < data_final Then Feriados = Feriados + 1 End If End If If Carnaval1 > data_inicial Then If Carnaval1 < data_final Then Feriados = Feriados + 1 End If End If If Carnaval2 > data_inicial Then If Carnaval2 < data_final Then Feriados = Feriados + 1 End If End If If Paixao > data_inicial Then If Paixao < data_final Then Feriados = Feriados + 1 End If End If If Corpo > data_inicial Then If Corpo < data_final Then Feriados = Feriados + 1 End If End If If tiradentes > data_inicial Then If tiradentes < data_final Then Feriados = Feriados + 1 End If End If If confraternizacao > data_inicial Then If confraternizacao < data_final Then Feriados = Feriados + 1 End If End If If Trabalho > data_inicial Then If Trabalho < data_final Then Feriados = Feriados + 1 End If End If If Independencia > data_inicial Then If Independencia < data_final Then Feriados = Feriados + 1 End If End If If Senhora > data_inicial Then If Senhora < data_final Then Feriados = Feriados + 1 End If End If If Natal > data_inicial Then If Natal < data_final Then Feriados = Feriados + 1 End If End If If Finados > data_inicial Then If Finados < data_final Then Feriados = Feriados + 1 End If End If If proclamacao > data_inicial Then If proclamacao < data_final Then Feriados = Feriados + 1 End If End If Aux = Aux + 1 Wend Corridos = Corridos - Feriados DiasUteis = Corridos End Function
  4. 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
×
×
  • Create New...