Ir para conteúdo
Fórum Script Brasil

Alyson Ronnan Martins

Membros
  • Total de itens

    847
  • Registro em

  • Última visita

Tudo que Alyson Ronnan Martins postou

  1. Você teria uma arquivo exemplo, com dados fictícios, assim te ajudar mais facilmente? É a tabela aonde é pego os nomes dos menus
  2. Bom dia. Foi realizar um teste no seu código e vi que está funcionando. Porém de uma maneira diferente... Quando agente vai fazer uma pesquisa usamos um textbox mais você, olhando o nome do campo, está usando um label: searchValue = VPesquisado.Caption Caso eu tenha entendi errado e o campo seja um textbox altere ele para ".value" assim vai pegar o texto do campo. Agora seguindo a sua regra de negócio eu coloquei um textbox para colocar a informação em um label com o nome que preenche a listview: Coloquei um evento para limpar o listview e depois mandei fazer o prenchimento novamente assim olhando o que precisa ser colocado: Option Explicit Private Sub campo_Change() AlterarValorPesquisado campo.Value LimparListViewRes PreencherListViewRes End Sub Private Sub UserForm_Initialize() AdicionarColunasListView PreencherListViewRes End Sub Sub AdicionarColunasListView() Dim coluna As ColumnHeader ' Adiciona as colunas With ListViewRes ' Adiciona as colunas com os cabeçalhos Set coluna = .ColumnHeaders.Add(, , "EMPRESA") coluna.Width = 52 Set coluna = .ColumnHeaders.Add(, , "PRODUTO") coluna.Width = 87 Set coluna = .ColumnHeaders.Add(, , "QUANTIDADE") coluna.Width = 100 Set coluna = .ColumnHeaders.Add(, , "APRESENTACAO") coluna.Width = 190 Set coluna = .ColumnHeaders.Add(, , "PREÇO 1") coluna.Width = 62 Set coluna = .ColumnHeaders.Add(, , "PREÇO 2") coluna.Width = 50 Set coluna = .ColumnHeaders.Add(, , "EAN") coluna.Width = 50 Set coluna = .ColumnHeaders.Add(, , "DATA") coluna.Width = 50 Set coluna = .ColumnHeaders.Add(, , "PUBLICADA") coluna.Width = 60 Set coluna = .ColumnHeaders.Add(, , "ATUALIZADA") coluna.Width = 60 ' Define o estilo das colunas (opcional) ListViewRes.View = lvwReport End With End Sub Sub PreencherListViewRes() Dim searchValue As String Dim ws As Worksheet Dim lastRow As Long Dim listViewRow As Long Dim resultListView As ListView ' Defina o nome da planilha onde você deseja procurar Set ws = ThisWorkbook.Sheets("TabelaValores") ' Defina o valor do rótulo a ser pesquisado searchValue = VPesquisado.Caption ' Limpar a ListView antes de adicionar novos resultados Set resultListView = ListViewRes ' Encontrar a última linha na coluna A lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Loop através das células na coluna A e verificar os valores For listViewRow = 2 To lastRow ' Começa na linha 2 para pular o cabeçalho If LCase(Trim(ws.Cells(listViewRow, 1).Value)) = LCase(Trim(searchValue)) Then ' Adicionar os valores das colunas B a K na ListView Dim col As Integer Dim newItem As ListItem Set newItem = resultListView.ListItems.Add(, , ws.Cells(listViewRow, "B").Value) For col = 3 To 11 ' Colunas C a K newItem.ListSubItems.Add , , ws.Cells(listViewRow, col).Value Next col End If Next listViewRow End Sub Public Sub LimparListViewRes() ListViewRes.ListItems.Clear End Sub Public Sub AlterarValorPesquisado(novoValor As String) VPesquisado.Caption = novoValor End Sub @IsraelB, olha se isso era o que estava procurando.
  3. Boa noite @davimilazzo Não consegui executar o código fornecido devido a esse erro:
  4. Qual o nome da tabela? para seu item abaixo: Dessa maneira é feita uma coisa por vez.
  5. Boa noite. Ficou um pouco confuso o seu objetivo, consegue dividir ela para tentar te ajudar?
  6. Bom dia. Você tentou acompanhar o processo inspecionando a sequências do seu código? Fazendo dessa maneira da para ter uma noção de onde esta acontecendo o problema.
  7. Bom dia. Vou classificar as duvidas que encontrei no seu texto e vou colocar em tópicos: Usar função procv no VBA: Application.VLookup Eu usaria uma iteração para encontrar o texto procurado dentro da tabela. Aguardo mais duvidas.
  8. Bom dia. Sua duvida ficou um pouco confusa.
  9. Bom dia. Depende um pouco do seu conhecimento, se tiver conhecimento em VBA dá sim para fazer o "auto preenchimento" mais se você quer apenas uma pesquisa recomendo fazer um campo no cabeçalho ou no rodapé. Se você tiver um mine projeto, com dados fictícios, posso dar uma ajudar na linha de raciocínio acima.
  10. Boa tarde. Olhando o código vi que colocou duas vezes o código “CopiaCola”. Pode ter sido apenas aqui no fórum. Para aumentar a velocidade ou desempenho do seu código recomendado desativar as atualizações de tela e atualização de cálculos. Isso melhora muito porque a macro não vai ter que esperar atualizar tela ou calcular as coisas. sub CopiaCola() 'Desativar a atualizado e calculo Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Seu código ... 'Ativar novamente a atualização e calclo Application.ScreenUpdating = originalScreenUpdating Application.Calculation = originalCalculation end sub Claro que para melhorar o desempenho as vezes você deve pensar ao contrário de uma lógico comum. Qual o real objetivo para levar as informações em outra tabela? Será que não poderia pegar o resultado que você espera usando outra solução em VBA? Mesmo assim se fosse necessário pegar essas informações eu acho que tentaria usar SQL na planilha. (Mais só testando para ver se daria certos) Espero ter ajudado
  11. Boa tarde. seria algo mais ou menos assim? Sub InserirLinha() Dim linhaParaInserir As Long ' Defina o número da linha onde você deseja inserir a nova linha linhaParaInserir = 3 ' Inserir uma nova linha acima da linha especificada Rows(linhaParaInserir).Insert End Sub
  12. Bom dia. Tenta usar o conteúdo desse artigo: Link
  13. Boa tarde. Já tentou executar seu código em modo de "debug", você pode verificar em que momento ele dar o erro 404. Dessa maneira você vai apertando F8 para ir acompanhando o seu código que foi executado.
  14. Boa tarde. Tenta definir a área de impressão por VBA: ActiveSheet.PageSetup.PrintArea = "$A$6,$A$3"
  15. Boa tarde. Tentar fazer uma consulta e usar o relatório para puxar os dados. quando você cria “sessão” (divisão para partes ou grupos do relatório) você pode colocar uma soma de determinado campo. Aí fica muito parecido com Excel.
  16. Boa tarde. Você não consegue acessar o banco de dados? Olhando ele você pode mudar seu usuário para Uppercase. Como esta a estrutura o projeto?
  17. Bom dia @Kisono Olha se esse código consegue clarear um pouco o que precisa: Sub ExtrairValoresDoSVG() Dim svgString As String Dim startIndex As Long, endIndex As Long Dim j As Long, val As Long, barHeight As Double ' Defina a string SVG svgString = "<path id=""SvgjsPath1981"" d=""M 63.19918062471707 90L 63.19918062471707 106.2Q 63.19918062471707 106.2 63.19918062471707 106.2L 67.99273125094312 106.2Q 67.99273125094312 106.2 67.99273125094312 106.2L 67.99273125094312 106.2L 67.99273125094312 90L 67.99273125094312 90z"" fill=""rgba(49,130,206,0.85)"" fill-opacity=""1"" stroke-opacity=""1"" stroke-linecap=""round"" stroke-width=""0"" stroke-dasharray=""0"" class=""apexcharts-bar-area"" index=""1"" clip-path=""url(#gridRectMaske8t52cy9)"" pathTo=""M 63.19918062471707 90L 63.19918062471707 106.2Q 63.19918062471707 106.2 63.19918062471707 106.2L 67.99273125094312 106.2Q 67.99273125094312 106.2 67.99273125094312 106.2L 67.99273125094312 106.2L 67.99273125094312 90L 67.99273125094312 90z"" pathFrom=""M 63.19918062471707 90L 63.19918062471707 106.2Q 63.19918062471707 106.2 63.19918062471707 106.2L 67.99273125094312 106.2Q 67.99273125094312 106.2 67.99273125094312 106.2L 67.99273125094312 106.2L 67.99273125094312 90L 67.99273125094312 90zL 63.19918062471707 90L 67.99273125094312 90L 67.99273125094312 90L 67.99273125094312 90L 67.99273125094312 90L 67.99273125094312 90L 63.19918062471707 90"" cy=""106.2"" cx=""67.99273125094312"" j=""13"" val=""-9"" barHeight=""-16.2"" barWidth=""4.793550626226045""></path>" ' Extrair o valor de "j" startIndex = InStr(svgString, "j=""") + 3 endIndex = InStr(startIndex, svgString, """") - 1 j = CLng(Mid(svgString, startIndex, endIndex - startIndex + 1)) ' Extrair o valor de "val" startIndex = InStr(svgString, "val=""") + 5 endIndex = InStr(startIndex, svgString, """") - 1 val = CLng(Mid(svgString, startIndex, endIndex - startIndex + 1)) ' Extrair o valor de "barHeight" startIndex = InStr(svgString, "barHeight=""") + 11 endIndex = InStr(startIndex, svgString, """") - 1 barHeight = CDbl(Mid(svgString, startIndex, endIndex - startIndex + 1)) ' Exibir os valores extraídos Debug.Print "j: " & j Debug.Print "val: " & val Debug.Print "barHeight: " & barHeight End Sub
  18. Boa noite @Ferdinaldo mais ou menos assim? #include <stdio.h> #include <math.h> #define SCREEN_WIDTH 80 #define SCREEN_HEIGHT 24 void drawCircle(int radius) { int x, y; int centerX = SCREEN_WIDTH / 2; int centerY = SCREEN_HEIGHT / 2; for (y = 0; y < SCREEN_HEIGHT; y++) { for (x = 0; x < SCREEN_WIDTH; x++) { int distance = (int) sqrt((x - centerX) * (x - centerX) + (y - centerY) * (y - centerY)); if (distance == radius) { printf("*"); } else { printf(" "); } } printf("\n"); } } int main() { int radius; printf("Digite o raio do círculo: "); scanf("%d", &radius); drawCircle(radius); return 0; }
  19. Boa noite @FernandoT Pelo que entendi você quer colocar um "textbox" usando a "área" da planilha: Se for isso que está planejando eu fiz os seguintes passos: Criar duas caixas de texto ativar o modo desenvolvimento Clicar duas vezes em cima da caixa de texto que quero alterar para acessar o VBA e colocar o código abaixo: para identificar essa opção de "KeyDown" eu pesquisei as opções disponíveis para o meu textobox1: Agora que coloquei para exibir uma mensagem, ao apertar qualquer botão, identifiquei os botões Enter e Tab: Enter: 13 Tab: 9 Com os botões identificado agora vamos fazer o comando para pular de janela: Agora basta fazer isso para o outro comando também: Link para download da planilha com o exemplo: Planilha no onedrive
  20. Bom dia. Olha se esse código abaixo te ajuda. 'Planilha não tem as informações completas, sendo nescessário ter uma base 'de dados para colocar as informações pesquisar e adcionar na planilha 'principal. Depois de adcionar classificar ' -> Recomendado base de dados ter um ID (identificação unica numérica) para relalizar pesquisas acertivas ' -> Adcionar colunas e linhas para fazer a classificação ' -> Percorrer a planilha Produtos para localizar as tag para classificar ' -> Classificar pelas colunas adicionadas Public Sub main() 'Processo principal 'Variáveis Dim x As Long 'Variável de iteração linhas Dim y As Long 'Variável de iteração colunas Dim lastRow As Long 'Ultima linha Dim wantedValue As String 'Pexto de pesquisa Dim rowInAnoterSheet As Variant 'Numero da linha na tabela produtos Dim shProducts As Worksheet 'tabela produto Set shProducts = Sheets("Produtos") 'Partindo do princípio que os dados começam na coluna B 'Add colunas Sheets("Itens").Select Columns("B:D").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight 'Adicionar títulos as colunas utilização iteração For y = 2 To 4 Cells(1, y).Value = "TAG " & y - 1 Next y 'Percorrer linnhas e adcionar as informações da colunas de classificações 'Iteração para linhas lastRow = Cells(Rows.Count, "E").End(xlUp).Row For x = 2 To lastRow wantedValue = Cells(x, "E").Value rowInAnoterSheet = SourchLineProduct(wantedValue) If rowInAnoterSheet = 0 Then Cells(x, 2).Value = "Não encontrado" Else For y = 2 To 4 Cells(x, y).Value = shProducts.Cells(rowInAnoterSheet, y).Value Next y End If Next x 'Classificar a tabela itens ActiveWorkbook.Worksheets("Itens").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Itens").Sort.SortFields.Add2 Key:=Range("B2:B" & lastRow), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("Itens").Sort.SortFields.Add2 Key:=Range("C2:C" & lastRow), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("Itens").Sort.SortFields.Add2 Key:=Range("D2:D" & lastRow), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Itens").Sort .SetRange Range("B1:I" & lastRow) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Public Function SourchLineProduct(TextFind As String) As Long On Error GoTo ErrorFind Dim res As Long res = Application.WorksheetFunction.Match(TextFind, _ Sheets("Produtos").Range("E:E"), 0) SourchLineProduct = res Exit Function ErrorFind: Err.Clear SourchLineProduct = 0 Exit Function End Function Planilha de exemplo: https://drive.google.com/file/d/1G49lhYiJt7UN4guvWfa0XCsGC8EsUyb0/view?usp=sharing
  21. Uma correção para o código: Public StatusContinueWrite As Boolean Public CurrentLine As Long Public Sub main() StatusContinueWrite = True: CurrentLine = 1 update End Sub Private Sub update() If StatusContinueWrite Then WriteOnLines Application.OnTime Now + TimeValue("00:00:01"), "update" Else MsgBox "Terminou" End If End Sub Private Sub WriteOnLines() Range("A" & CurrentLine).Value = "A": CurrentLine = CurrentLine + 1 End Sub Agora um exemplo de como está o código: Arquivo exemplo no google drive: https://drive.google.com/file/d/1XGf5VDCiWvzI9lyLk__PeshyVibj52HF/view?usp=sharing Verifica esse último código.
  22. Dim continueWriting As Boolean Sub StartWriting() continueWriting = True WriteText End Sub Sub StopWriting() continueWriting = False End Sub Sub WriteText() Dim rng As Range Set rng = Range("A1") While continueWriting If Application.SendKeys("{F2}") Then Exit Sub Else rng.Value = "A" Set rng = rng.Offset(1, 0) End If Wend End Sub
  23. Boa noite @Thamires Furtuoso Alexandre. Teria como fazer uma planilha "fictícia" sem estar classificar e outra já classificada? (só para entender como deve ser o botão de classificação)
×
×
  • Criar Novo...