Ir para conteúdo

Pesquisar na Comunidade

Mostrando resultados para as tags ''vba''.

  • Pesquisar por Tags

    Digite tags separadas por vírgulas
  • Pesquisar por Autor

Tipo de Conteúdo


Calendários

  • Comunidade iMasters

Todas as áreas do Fórum

  • Q&A Desenvolvimento
    • Perguntas e respostas rápidas
  • Desenvolvimento Web
    • Desenvolvimento frontend
    • Javascript
    • PHP
    • Ruby
    • Python
    • Java
    • .NET
    • Docker, Kubernets e outros ambientes
    • Desenvolvimento com Wordpress
    • Desenvolvimento de apps
    • Desenvolvimento ágil
    • Desenvolvimento de Games
    • Banco de Dados
    • Design e UX
    • Algoritmos & Outras Tecnologias
  • Entretenimento e uso pessoal
    • Segurança & Malwares
    • Geral
    • Boteco iMasters

Encontrar resultados em...

Encontrar resultados que...


Data de Criação

  • Início

    FIM


Data de Atualização

  • Início

    FIM


Filtrar pelo número de...

Data de Registro

  • Início

    FIM


Grupo


Google+


Hangouts


Skype


Twitter


deviantART


Github


Flickr


LinkedIn


Pinterest


Facebook


Site Pessoal


Localização


Interesses

Encontrado 9 registros

  1. Sou estudante de Programação e nunca tinha usado VBA e tenho de entregar um trabalho, mas nunca tive formação nesta linguagem, e estou a ter problemas no programa na parte de Pesquisar registros com filtros, já tentei ao máximo fazer seguindo tutoriais na internet, até que uma pessoua me ajudou e mandou-me codia e disse para fazer um passos só que eu nao sei seguir esses passos. Fico muito agradecido se alguém me conseguir ajudar. O que a pessoa me indicou: " Para testar o código coloque um filtro na planilha Dados no range A1:L1 e crie uma planilha com o nome de Auxiliar. Cole o código no formulário Pesquisar. " Option Explicit Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text) End Sub Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text) End Sub Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text) End Sub Private Sub UserForm_Initialize() ComboBox1.RowSource = "Relatório!A1:A12" ComboBox2.RowSource = "Relatório!A1:A12" ComboBox3.RowSource = "Relatório!A1:A12" End Sub Sub Filtro(ByVal Pesquisa As String, Campo As String) Dim Coluna As Integer Dim Area As Range Set Area = ThisWorkbook.Sheets("Dados").[A1:L1] Coluna = WorksheetFunction.Match(Campo, Area, 0) If Pesquisa <> "" Then If IsNumeric(Pesquisa) = False Then Pesquisa = "*" & Pesquisa & "*" Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisa) Call CopiaTabela Call PreencheListBox End If End Sub Sub CopiaTabela() ThisWorkbook.Sheets("Auxiliar").[A:L].Clear ThisWorkbook.Sheets("Dados").[A1].CurrentRegion.Copy ThisWorkbook.Sheets("Auxiliar").[A1].PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub Sub PreencheListBox() Dim Area As Range Set Area = ThisWorkbook.Sheets("Auxiliar").[A1].CurrentRegion ListBox1.ColumnCount = Area.Columns.Count ListBox1.ColumnHeads = True ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address End Sub Link do Programa: https://drive.google.com/file/d/1ucJVL5Ijg0IcDqaFzoJi8aiMPb0NCbjI/view?usp=sharing
  2. gereiz

    Renomear vários arquivos com VBA

    Bom dia a todos. Adaptei um código para renomear vários arquivo com vba, que realiza a seguinte função: 1) Eu seleiono a pasta, 2) O VBA abre o PDF (Nota fiscal) , extrai a informação do texto e com a razão social fecha o pdf e renomeia ele com o nome extraido. O problema é que após renomear o primeiro arquivo corretamente a execução do código trava, e é necessário finalizar o processo. Segue abaixo o código. Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) Public Function ListaArquivos(ByVal Caminho As String) As String() 'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime Dim FSO As New FileSystemObject Dim result() As String Dim Pasta As Folder Dim Arquivo As File Dim Indice As Long ReDim result(0) As String If FSO.FolderExists(Caminho) Then Set Pasta = FSO.GetFolder(Caminho) For Each Arquivo In Pasta.Files Indice = IIf(result(0) = "", 0, Indice + 1) ReDim Preserve result(Indice) As String result(Indice) = Arquivo.Name Next End If ListaArquivos = result ErrHandler: Set FSO = Nothing Set Pasta = Nothing Set Arquivo = Nothing End Function Private Sub selecionar_pasta() Dim box As Folder Dim arquivos() As String Dim lCtr As Long Dim AdobeApp As String Dim StartAdobe Dim Arquivo As String Dim NomeAntigo As String Dim NomeNovo As String On Error Resume Next linha = 1 ultima_linha = Sheets("teste").Cells(Rows.Count, 1).End(xlUp).Row With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Buscar pasta" .InitialFileName = ThisWorkbook.Path .Show .AllowMultiSelect = False Pasta = .SelectedItems(1) End With TextBox1 = box arquivos = ListaArquivos(Pasta) Sleep 1000 For lCtr = 0 To UBound(arquivos) Debug.Print arquivos(lCtr) 'Inserir código aqui' 'Cells(linha, 1).Value = arquivos(lCtr) 'linha = (linha + 1) 'Sleep 500 pdf = arquivos(lCtr) AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" Sleep 2000 For Each pdf In Pasta Adobefile = Pasta & "\" & pdf StartAdobe = Shell("" & AdobeApp & " " & """" & Adobefile & """" & "", 1) Sleep 2000 Application.SendKeys ("^a") Application.SendKeys ("^c") Sleep 2000 Dim KillPdf As String KillPdf = "TASKKILL /F /IM AcroRd32.exe" Shell KillPdf, vbHide AppActivate Application.Caption Sheets("teste").Range("A1").Activate SendKeys ("^v") DoEvents Dim Razao As String Razao = Sheets("teste").Range("A17").Value pontos = InStr(1, Razao, ":") qtdeLetras = Len(Razao) Nome = Right(Razao, qtdeLetras - pontos) Sheets("teste").Range("C1").Value = Nome Do While Not IsEmpty(Range("C1")) NomeAntigo = Pasta & "\" & pdf NomeNovo = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf" Sheets("teste").Range("C2").Value = Adobefile Sheets("teste").Range("C3").Value = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf" Name NomeAntigo As NomeNovo ' DoEvents Loop ' MsgBox "Nomes dos arquivos alterados!", vbOKOnly, "Processo Concluído" Next Next ' MsgBox ("Arquivos Encontrados = ") & (linha - 1) End Sub Já tentei de tudo, e não consegui resolver esse problema, se eu remover o Do while, ele executa normalmente, porem não renomeia os arquivos. Seu eu faço esse laço, ele renomeia só o primeiro e trava geral. Qualquer esclarecimento, agradeço.
  3. Olá! Estou com problema referente a exportação de gráficos do Excel via VBA para apresentação do PowerPoint. A maneira que encontrei, inclusive em várias fontes é de exportar vários gráficos de uma vez ou uma ,em uma nova apresentação. O que estou precisando é de exportar os gráficos do Excel em um arquivo do PowerPoint existente, em slides e locais específicos das apresentações. Se alguém tiver alguma ideia de como fazer seria de muita ajuda.
  4. sapinhox

    [Resolvido] Erro em aplicação em VBA

    Tenho um programa desenvolvido em VBA para Autocad, o mesmo tem duas linhas de programação que estão dando o seguinte erro: as linhas que estão dando erro são as seguintes Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Acredito que tenha alguma coisa a ver do fato do sistema instalado ser 64 bits, algum tem alguma solução para o caso. Desde já agradeço
  5. cesarhtc

    modulo access

    Boa tarde não estou conseguindo rodar o codigo abaixo: Const IntervaloSegundos = 5 * 60 ' 5 minutos de intervalo Sub Iniciar() Alarme = Now + TimeSerial(0, 0, IntervaloSegundos) Application.OnTime EarliestTime:=Alarme, procedure:="Macro_Atualizar_Tramite_web", schedule:=True End Sub Function Macro_Atualizar_Tramite_web() On Error GoTo Macro_Atualizar_Tramite_web_Err DoCmd.SetWarnings False DoCmd.OpenQuery "CRIAR_TABELA_TRAMITACAO_CONTRATACAO", acViewNormal, acEdit DoCmd.OpenQuery "CRIAR_TABELA_TRAMITACAO_CONSUMO", acViewNormal, acEdit Beep MsgBox "Dados Atualizados!", vbExclamation, "Carga" Macro_Atualizar_Tramite_web_Exit: Exit Function Macro_Atualizar_Tramite_web_Err: MsgBox Error$ Resume Macro_Atualizar_Tramite_web_Exit Call Iniciar End Function Sub Parar() On Error Resume Next Application.OnTime EarliestTime:=Alarme, procedure:="Macro_Atualizar_Tramite_web", schedule:=False End Sub Obrigado
  6. Ola amigos é minha primeira vez no forum, Estou com o seguinte problema: efetuei uma planilha em vba excel, porem em uma determinada textbox, estou tendo dor de cabeça, fiz uma tabela que busca de valores e insere de valores. Na tabela fde inserção de valores, tudo, ok efetuei a formula com comando Cdate(textde) - quando preenche a mesma ela inserre corretamente em formato de datas porem, na busca de valores quando a celula na estão preenchida ele nãos tras nada nesta txtDE, e quando eu efetuo a alteração ele da erro, porque na opção "Cdade" tem que esdta preenchida com alguma coisa... consegume me ajudar? ' este faz a busca de valores: Private Sub txtLocaliza_AfterUpdate() Dim intervalo As Range Dim texto As String Dim codigo As Integer Dim pequisa Dim mensagem codigo = txtLocaliza.Value 'Sheets("Clientes").Select Set intervalo = Sheets("Clientes").Range("A:Y") On Error GoTo trataErro pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, False) pesq1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 3, False) pesq2 = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False) pesq3 = Application.WorksheetFunction.VLookup(codigo, intervalo, 5, False) pesq4 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False) pesq5 = Application.WorksheetFunction.VLookup(codigo, intervalo, 7, False) pesq6 = Application.WorksheetFunction.VLookup(codigo, intervalo, 8, False) pesq7 = Application.WorksheetFunction.VLookup(codigo, intervalo, 9, False) pesq8 = Application.WorksheetFunction.VLookup(codigo, intervalo, 10, False) pesq9 = Application.WorksheetFunction.VLookup(codigo, intervalo, 11, False) pesq10 = Application.WorksheetFunction.VLookup(codigo, intervalo, 12, False) pesq11 = Application.WorksheetFunction.VLookup(codigo, intervalo, 13, False) pesq12 = Application.WorksheetFunction.VLookup(codigo, intervalo, 14, False) pesq13 = Application.WorksheetFunction.VLookup(codigo, intervalo, 15, False) pesq14 = Application.WorksheetFunction.VLookup(codigo, intervalo, 16, False) pesq15 = Application.WorksheetFunction.VLookup(codigo, intervalo, 17, False) pesq16 = Application.WorksheetFunction.VLookup(codigo, intervalo, 18, False) pesq17 = Application.WorksheetFunction.VLookup(codigo, intervalo, 19, False) pesq18 = Application.WorksheetFunction.VLookup(codigo, intervalo, 20, False) pesq19 = Application.WorksheetFunction.VLookup(codigo, intervalo, 21, False) pesq20 = Application.WorksheetFunction.VLookup(codigo, intervalo, 22, False) pesq21 = Application.WorksheetFunction.VLookup(codigo, intervalo, 23, False) pesq22 = Application.WorksheetFunction.VLookup(codigo, intervalo, 24, False) pesq23 = Application.WorksheetFunction.VLookup(codigo, intervalo, 25, False) pesq24 = Application.WorksheetFunction.VLookup(codigo, intervalo, 1, False) lblCod = pesq24 txtAddress = CDate(pesquisa) txtNumber = pesq1 txtNeighb = pesq2 txtCity = pesq3 cbUF = pesq4 txtDDD1 = Format(CCur(pesq5), "#0.000") txtPhone1 = Format(CCur(pesq6), "#0.000") txtDDD2 = Format(CCur(pesq7), "#0.000") txtPhone2 = Format(CCur(pesq8), "#0.000") txtEmail = Format(CCur(pesq9), "#0.000") txtmn = Format(CCur(pesq10), "#0.000") txtti = Format(CCur(pesq11), "#0.000") txtal = Format(CCur(pesq12), "#0.000") txtcomplemento = pesq13 If pesq14 <> "" Then txtDT = CDate(pesq14) End If txtIN = pesq15 txtTR = pesq16 ''If pesq17 <> "" Then txtPeso = Format(CCur(pesq17), "###,##0.000") ''End If txtPecas = pesq18 ''If pesq19 <> "" Then txtPB = Format(CCur(pesq19), "###,##0.000") ''End If ''If pesq20 <> "" Then txtPL = Format(CCur(pesq20), "###,##0.000") ''End If If pesq21 <> "" Then txtDE = CDate(pesq21) End If txtDS = pesq22 txtVT = pesq23 Exit Sub trataErro: texto = "Não Localizado" mensagem = MsgBox(texto, vbOKOnly + vbInformation) End Sub 'este altera na tabela Sub lsAlterarStudent() 'Define a Range de Pesquisa Set currentFind = Worksheets("Clientes").Range("A:A").Find(frmCadastroStudents.lblCod, , _ Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _ Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False) lLinha = currentFind.Row With frmCadastroStudents Sheets("Clientes").Cells(lLinha, 2).Value = CDate(.txtAddress) Sheets("Clientes").Cells(lLinha, 3).Value = .txtNumber Sheets("Clientes").Cells(lLinha, 4).Value = .txtNeighb Sheets("Clientes").Cells(lLinha, 5).Value = .txtCity Sheets("Clientes").Cells(lLinha, 6).Value = .cbUF Sheets("Clientes").Cells(lLinha, 7).Value = CCur(.txtDDD1) Sheets("Clientes").Cells(lLinha, 8).Value = CCur(.txtPhone1) Sheets("Clientes").Cells(lLinha, 9).Value = CCur(.txtDDD2) Sheets("Clientes").Cells(lLinha, 10).Value = CCur(.txtPhone2) Sheets("Clientes").Cells(lLinha, 11).Value = CCur(.txtEmail) Sheets("Clientes").Cells(lLinha, 12).Value = CCur(.txtmn) Sheets("Clientes").Cells(lLinha, 13).Value = CCur(.txtti) Sheets("Clientes").Cells(lLinha, 14).Value = CCur(.txtal) Sheets("Clientes").Cells(lLinha, 15).Value = .txtcomplemento Sheets("Clientes").Cells(lLinha, 16).Value = CDate(.txtDT) Sheets("Clientes").Cells(lLinha, 17).Value = .txtIN Sheets("Clientes").Cells(lLinha, 18).Value = .txtTR ''If txtPeso <> "" Then Sheets("Clientes").Cells(lLinha, 19).Value = CCur(.txtPeso) ''End If Sheets("Clientes").Cells(lLinha, 20).Value = .txtPecas ''If txtPB <> "" Then Sheets("Clientes").Cells(lLinha, 21).Value = CCur(.txtPB) ''End If ''If txtPL <> "" Then Sheets("Clientes").Cells(lLinha, 22).Value = CCur(.txtPL) ''End If ''If txtDE <> "" Then Sheets("Clientes").Cells(lLinha, 23).Value = CDate(.txtDE) ''End If Sheets("Clientes").Cells(lLinha, 24).Value = .txtDS Sheets("Clientes").Cells(lLinha, 25).Value = .txtVT End With End Sub
  7. Pessoal, tudo bem? Eu infelizmente sou uma pessoa muito newbie no Access, e extremamente enferrujada no VBA, e eu tenho que criar um banco de dados para importar várias planilhas de Mês/Ano (Ex.: 012018; 022018) sempre do mesmo modelo/molde/afins, e no fim, gerar um relatório com as informações importadas. O modelo relatório e o modelo tabela estão prontos, entretanto, não sei como criar o formulário que faça: 1º: Clicar no botão procurar arquivo; 2º: Solicite o Mes/Ano do arquivo que será importado; 3º: Abra a API do Windows de localizar arquivo; 4º: Ao selecionar e importar o arquivo, dê baixa na tabela definida. A tabela e o arquivo tem todos as mesmas colunas, entretanto, eu inseri a coluna MesAno na tabela que deverá ser inserida conforme a pergunta que foi solicitada no formulário. Pois o relatório será gerado de acordo com essa coluna.
  8. Prezados,boa noite!Me ajudem, por favor.Tenho que lançar diversos dados em uma página da receita federal.nesta página, há formulários que devem ser preenchidos de acordo com o que se pede.São 3 páginas, e nelas são solicitados dados distintas uma das outras.tenho uma planilha no Excel, onde consta todos esses dados, totalmente organizados.Eu faço um trabalho de quase 3 horas só para copiar estes dados da planilha do excel (CTRL + C) e enviar para estes formularios (CTRL+V).(São diversos clientes, cada cliente tem x operações, cada operação tem que ser lançada nessa página, gerando diversos lançamentos no dia a dia).Vocês podem me ajudar a criar um macro para automatizar isso?Eu já vi um na internet, que entra no site dos correios, faz uma consulta e dentro dessa consulta, ele resgata alguns dados e lança na planilha do excel.mas não consegui adapta-lo do modo que eu quero.. pois não entendi como funciona o código.não quero lançar nada do navegador para o excel, e sim do excel para o navegador.assim como também, ele deve apertar em botões na página. (avançar, para trocar de página).eu posso pagar , como posso agradecer. =)
  9. raffrenan

    EXCEL + VBA [ LISTVIEW ]

    E ae galera, seguinte, estou desenvolvendo um sistema em vba no excel para a empresa que trabalho, porém estou utilizando um sistema de consulta com listview, onde ele busca do banco de dados, porém preciso que esses dados sejam mostrados em uma textbox específica, porém não estou conseguindo, segue o código: Private Sub Btn_Consulta_Click() Dim strSql As String ID = Me.TxtConsulta Set rs = New ADODB.Recordset strSql = "SELECT ID_Monitor AS [Código], Nome AS [Nome do Operador]," strSql = strSql & " * FROM Monitores WHERE ID_Monitor LIKE '" & ID & "'" rs.Open strSql, MiConexao On Error Resume Next Me.Lista.ListItems.Clear With Me.Lista .View = lvwReport .Gridlines = True .FullRowSelect = True .ColumnHeaders.Clear For i = 0 To rs.Fields.Count - 1 .ColumnHeaders.Add i + 1, , VBA.UCase(rs(i).Name) Next i End With While Not rs.EOF Set Lrst = Me.Lista.ListItems.Add(Text:=rs(0)) Lrst.SubItems(1) = rs(1) Lrst.SubItems(2) = rs(2) Lrst.SubItems(3) = rs(3) Lrst.SubItems(4) = rs(4) Lrst.SubItems(5) = rs(5) Lrst.SubItems(6) = rs(6) rs.MoveNext Wend Me.TxtConsulta = "" Me.TxtConsulta.SetFocus End Sub Private Sub Lista_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim Linha As Variant Linha = Me.Lista.List.Index Me.TxtNomeView = Me.Lista.List(Linha, 3) End Sub Private Sub UserForm_Initialize() Call Conecta End Sub Lembrando que ele consulta normalmente e mostra na listview, porém quando eu clico em uma opção da lista ele retorna erro.
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.