Ir ao conteúdo
  • Cadastre-se

Basole

Membro Pleno
  • Posts

    2.019
  • Cadastrado em

Tudo que Basole postou

  1. @Gabrielle Cordeiro bom dia. Para atender 100 % sua demanda, é necessário disponíbilizar o arquivo ou um exemplo com alguns dados fictícios, e que contenha as mesmas fórmulas e formatos do exemplo imagem, que você postou.
  2. @Miguelriedel segue sugestão. Formula matricial [ cltr+shift+enter ] *Outra opção s/ matricial, com a função agrupar Exemplo_Procv_Mult_Ocorren_Agrupar.xlsx Exemplo_Procv_Mult_Ocorren.xlsx
  3. @samara.vba use a funcao environ Exemplo: Sub Teste_Usuario() MsgBox vba.Environ("USERPROFILE") & "\Desktop\pasta x\fotos\01.jpg" End Sub
  4. @Scofieldgyn Segue opção: No modulo de EstaPasta_de_trabalho Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Ev As String Ev = "Salvou" Call Test_LOG(Ev) End Sub Pode criar uma aba nomeando-a como Log ...em um modulo padrão: Sub Test_LOG(Ev As String) Dim linha! With ThisWorkbook.Sheets("Log") If Cells(Rows.Count, 1).End(xlUp).Row <= 1 Then .Range("A1").Value = "Evento" .Range("B1").Value = "Usuario" .Range("C1").Value = "Dominio" .Range("D1").Value = "Computador" .Range("E1").Value = "Data e Hora" linha = 2 End If linha = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row .Range("A" & linha).Value = Ev .Range("B" & linha).Value = VBA.Environ("UserName") .Range("C" & linha).Value = VBA.Environ("USERDOMAIN") .Range("D" & linha).Value = VBA.Environ("COMPUTERNAME") .Range("E" & linha).Value = VBA.Now() .Columns.AutoFit End With End Sub
  5. @josequali bom dia! Experimente a função max ' Se o campo Origem for numerico (valor) rs.Open "SELECT MAX(campo_Numerico) FROM TabNaoConformidades WHERE [campo_Numerico]>0", Db, 3, 3 ' Se o campo Origem for do tipo string rs.Open "SELECT MAX(campo_String) FROM TabNaoConformidades WHERE [campo_String]>'0'", Db, 3, 3 If Not rs.EOF Then Me.txtId1.Text = rs(0).Value + 1 End If
  6. @Murilo_Correa experimente agora com as alterações Fiz uns remendos no que já havia feito, e agora ficou parecendo um frankenstein, mas deve fucinionar: * Se puder post o print com o resultado da importação, para efito de ilustração aqui no topico: Sub Login_Suframa_Por_Celulas() ' Por bbasole882gmail.com Dim driver As New ChromeDriver Dim r As Range Dim Row As Object Dim body As Object Dim cell As Object Dim x: x = 1 Dim oTable As Object Dim RowTh As Object Dim cellTh As Object Dim sThtd As String: sThtd = "th" On Error GoTo trER: Excel.Application.ScreenUpdating = False With driver .Get "https://simnac.suframa.gov.br" .Wait (1000) .FindElementByName("usuario").SendKeys ("USUARIO") ' * ALTERAR .FindElementByName("senha").SendKeys ("SENHA") ' * ALTERAR .Wait (1000) .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click .Wait (5000) ' adiciona nova aba: With ThisWorkbook .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo_1" End With .Wait (1000) For Each oTable In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table") For Each RowTh In oTable.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr") For Each cellTh In RowTh.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[" & x & "]/" & sThtd & "") y = y + 1 If VBA.InStr(1, cellTh.Text, "TOTAL") > 0 Then y = 9: Cells(x, y) = VBA.Replace(cellTh.Text, VBA.Chr(10), " ") Else Cells(x, y) = VBA.Replace(cellTh.Text, VBA.Chr(10), " ") End If Next ' efeito zebrado no intevalo de dados: If x Mod 2 <> 0 Then Set r = Range(Cells(x, 1), Cells(x, 9)): r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.25 '15 End If x = x + 1 y = 0 sThtd = "td" Next RowTh Next oTable x = 1: y = 0 For Each body In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table") For Each Row In body.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr") For Each cell In Row.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr[" & x & "]/td") y = y + 1 If VBA.InStr(1, cell.Text, "TOTAL DE PENDÊNCIAS POR DIAS PARA EXPIRAÇÃO DO PRAZO") > 0 Then y = 4: Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " "): Cells(x + 2, y).Font.Bold = True ' negrito Else If VBA.IsNumeric(cell.Text) And y = 1 Then Cells(x + 2, y) = "" ElseIf VBA.InStr(1, cell.Text, "Vistoria ") > 0 And y = 1 Then y = 2 Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ") Else Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ") End If End If Next cell ' efeito zebrado no intevalo de dados: If x Mod 2 <> 0 Then Set r = Range(Cells(x + 2, 1), Cells(x + 2, 9)): r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.15 End If x = x + 1 y = 0 Next Row Next body Range("A:A").EntireColumn.ColumnWidth = 3.2: Range("B:D").EntireColumn.ColumnWidth = 45: Range("E:i").EntireColumn.ColumnWidth = 8.2 Range("1:1").EntireRow.RowHeight = 26.75: Range(Cells(1, 1), Cells(1, 9)).Font.Size = 12: Range(Cells(1, 1), Cells(1, 9)).Font.Bold = True ' negrito .Quit End With trER: Excel.Application.ScreenUpdating = True End Sub
  7. @Guilherme Stoduto Você pode postar aqui os arquivos, compactando-os
  8. @Murilo_Correa obrigado! Sim exatamente isso, puxa direto do site. O codigo copia o objeto tabela do site e com a função, que eu não conhecia, do selenium ToExcel cola os dados na aba. Mas pena que os dados no site não são organizados como uma verdadeira tabela ou seja, fora de tabulação, isso atrapalha na hora fazer a programação, Mas eu ajustei o codigo abaixo, para percorrer todas as celulas da tabela do site e puxar os dados e inserir mais organizadamente possível e desconsiderando a primeira coluna que contem os numeros, pois contem celulas mescladas * 1 - Esta tabela segue um padrão das demais consultas? * 2 - Insira ou ajuste os wait(s) no codigo, se necessario de acordo com o carregamento das paginas. * 3 -Se preferir da pra ajustar no codigo para o navegador chrome ficar com a tela invisivel. Sub Login_Suframa_Por_Celulas() Dim driver As New ChromeDriver Dim r As Range Dim Row As Object Dim body As Object Dim cell As Object Dim x: x = 1 With driver .Get "https://simnac.suframa.gov.br" .Wait (1000) .FindElementByName("usuario").SendKeys ("USUARIO") ' * USUARIO .FindElementByName("senha").SendKeys ("SENHA") ' * SENHA .Wait (1000) .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click .Wait (5000) ' adiciona nova aba: With ThisWorkbook .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo_1" End With .Wait (1000) For Each body In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody") For Each Row In body.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr") For Each cell In Row.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr[" & x & "]/td") y = y + 1 If VBA.InStr(1, cell.Text, "TOTAL DE PENDÊNCIAS POR DIAS PARA EXPIRAÇÃO DO PRAZO") > 0 Then y = 4: Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ") Else If VBA.IsNumeric(cell.Text) And y = 1 Then Cells(x, y) = "" ElseIf VBA.InStr(1, cell.Text, "Vistoria ") > 0 And y = 1 Then y = 2 Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ") Else Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ") End If End If Next cell ' efeito zebrado no intevalo de dados: If x Mod 2 <> 0 Then Set r = Range(Cells(x, 1), Cells(x, 9)) r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.15 End If x = x + 1 y = 0 Next Row Next body Range("B:D").EntireColumn.ColumnWidth = 45 Range("E:i").EntireColumn.ColumnWidth = 2.5 End With End Sub
  9. @Masterresende pode criar um link da pasta e baixar compactado. Tem varios exemplo de descompactação na net.
  10. @Murilo_Correa boa tarde, Experimente as alterações : O ultimo comando importa todos os dados da tabela para uma nova aba que é criada na sua planilha. * Na tabela (conf. imagens que enviou anterirmente), os dados estão fora de tabulação. Acho que o ideal é fazer um loop atraves das celulas trazendo dado-a-dado. De qualquer forma teste ai e vamos ajustando: Sub Login_Suframa() Dim driver As New ChromeDriver Dim tblItems As Selenium.TableElement With driver .Get "https://simnac.suframa.gov.br" .FindElementByName("usuario").SendKeys ("") .FindElementByName("senha").SendKeys ("") .Wait (1000) .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click .Wait (5000) ' Exportar a planilha: ' .FindElementByXPath("//*[@id=""content""]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/header/h2/div/button", 5).Click .Wait (5000) Set tblItems = .FindElementByXPath("(.//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table)[1]").AsTable End With With ThisWorkbook .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo" tblItems.ToExcel .ActiveSheet.Range("A1") End With End Sub
  11. Experimente.... Acrescente a linhas abaixo no codigo: Dim tabItems As WebElements Dim Item As WebElements Set tabItems = .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[1]/th[1]") Debug.Print tabItems.Count For Each Item In tabItems MsgBox Item.Text Next Item
  12. voce selecionou o campo SOLICITAR RERISTRO DO PIN DA NF DE IMPORTACAO. Vamos tentar pelo ID. Que é a primeira linha e primeira coluna com dados, da tabela, acredito que nesta linha está a informação que preciso. Quando encontrar, coloque o cursor, e na tabela, o campo, deverá ficar destacado, é esse item que deverá copiar.
  13. @Murilo_Correa bom dia, Acho que seria mais rápido e mais prático, se conseguirmos "puxar" os dados diretamente do site, podemos tentar mesmo sem eu ter acesso a página? Na pagina da tabela, no campo: NF e importada selecione e com o botão direito do mouse click em inspecionar, na tela de console pesquise por NF e importada e copie o xpath, e tambem tire um print desta tela.
  14. @Maria Laura experimente o codigo abaixo Atualiza no vinculo, com nome da atual Planilha, e converte os dados para valores Faça um backup de seus arquivos, antes de testar Sub Alterara_NArquivo_Excel_Vinculo() Dim wbTrg As Workbook Dim sLinkNew As String Dim aLinks As Variant Dim vLink As Variant ' * AQUI * altere o caminho e nome da pasta_de_trabalho * sLinkNew = "C:\Users\Nome_Usuario\Documents\Controle.xlsx" Set wbTrg = ThisWorkbook aLinks = ActiveWorkbook.LinkSources(xlExcelLinks) ' Repassa cada vinculo Link If Not IsEmpty(aLinks) Then For Each vLink In aLinks wbTrg.ChangeLink Name:=vLink, NewName:=sLinkNew, Type:=xlExcelLinks wbTrg.BreakLink Name:=sLinkNew, Type:=xlLinkTypeExcelLinks Debug.Print sLinkNew Next: End If End Sub Adaptado de: https://stackoverflow.com/questions/47452637/excel-vba-macro-change-link-name
  15. @Murilo_Correa bom dia! Temos duas imagens de planilhas semelhantes, e voce precisa atualizar os dados a primeira a com a segunda. Mas se voce fosse atualizar manualmente, quais celulas estariam envolvidas ? Só lembrando que somos voluntários aqui, e ficar analisando dados fora da nossa área é complicado.
  16. @Scofieldgynbom dia! Quando diz Private se refere a worksheet_selectionchange? Se for isso pode-se adptar o mesmo código do meu exemplo, a uma macro/sub. Mas não vai ficar mais, de forma automatica, ou seja precisa-se de um botão. Quanto as marcas, no exemplo que enviou eu só vi uma marca como exemplo Quanto a excluir os anexos dos posts, eu não tenho acesso para tal. Acredito que o mestre @Patropi possa fazer isso
  17. @Scofieldgyn segue sugestão com Pop-up. Ao clicar em Histórico vs Nova Meta aparce um popup com as diferença de cada marca, e incluindo os dados dinâmicamente, de acordo com a coluna DIF.
  18. A partir daqui não tem como eu testar, Experimente substituir esta linha: .FindElementByXPath("//*[@id=""content""]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/header/h2/div/button/text()", 5).Click
  19. Sim, se está demorando para carregar pode ser isso É bom acrescentar uma "espera" de 3 segendos antes dessa linha : .Wait (3000) De qualquer forma para ter mais certeza, na tela do console Onde esta destacado em amarelo, coloque o o cursor e com o botão direito do mouse click em Copy e em seguinda em Copy XPath e cole na sua resposta/post
  20. @Murilo_Correa quanto a este problema com o botão ENTRAR, altere no código a linha: .FindElementByTag("button").Click Por esta: .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
  21. Sim dá para automatizar todo esse processo de importação desde que o arquivo siga um padrão de formatação. Para importar a planilha do site, experimente acrescentar a linha abaixo no final do código .FindElementByLinkText("Exportar Planilha").Click Edit. @Murilo_Correa Vendo as novas imagens, atualizei abaixo .FindElementByLinkText(" Exportar Planilha ").Click
  22. A opção que vejo na pagina, nas imagens que enviou é botão Exportar Planilha. Vai gerar e baixar um novo arquivo com esses dados Como não tenho acesso a pagina, acredito que seja mais fácil baixar e depois importar esses novos dados para sua planilha. Edit: @Murilo_Correa se tiver a opção de exportar a tabela no formato html, tambem seria uma boa opção para automatizar a importação dos para sua planilha Edit 2: @Murilo_Correa Com a tela do console (F12) aberta, aperte as [ ctrl + f ] p/ pesquisar, e digite Exportar Planilha e tire um print do da tela.
  23. @Murilo_Correa considerando que já fez os procedimentos de instalação do selenium basic 2.0.9.0 e atualização do chromedriver na pasta do selenium, e tambem ja marcou a referencia "Selenium Type Library" no seu arquivo do Excel Segue uma rotina básica para inserir os dados de login no referido website. Sub Login_Suframa() Dim driver As New ChromeDriver With driver .get "https://simnac.suframa.gov.br" .FindElementByName("usuario").SendKeys ("Nome_do_Usuario") ' * AQUI altere usuario .FindElementByName("senha").SendKeys ("12345") ' * AQUI altere senha .Wait (1000) .FindElementByTag("button").Click .Wait (1000) End With End Sub
  24. Qual o motivo para não utilizar o internet explorer, já que lhe atende bem? Com o Chrome, vai precisar instalar o Selenium. Dependendo da politica da empresa, não permitem fazer tal instalação.
  25. @Taiuan Reis Santosveja se é isso - 04 - ANO 2022 - Pedidos Entregues (1).xlsx

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...