Ir para conteúdo
Fórum Script Brasil

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


Fóruns

  • 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

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


AIM


MSN


Website URL


ICQ


Yahoo


Jabber


Skype


Location


Interests

  1. No rodapé deste site "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" tem um ícone que faz o download de um arquivo .xls. Eu precisava clicar nele e salvar o arquivo, mas não sei como fazê-lo. Segue o código, adaptado de um outro fornecido pelo danieltakeshi, das duas formas que eu tentei fazer (a segunda marcada com *) nas duas a página abre e não acontece nada. Sub TesteBusca() Dim IE As Object Dim sWindows As Object Dim sJanelas As Object Dim sDados As String Dim doc As MSHTML.HTMLDocument Set IE = CreateObject("InternetExplorer.Application") IE.navigate "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" IE.Visible = True EsperaIE IE, 2000 'Debug.Print IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a").innerText i = 1 For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a") 'Debug.Print EXTRAIRELEMENTO(link.href, 8, "/") If EXTRAIRELEMENTO(link.href, 7, "/") = "DIARIO_18-03-2018.xlsx" Then i = i + 1 link.Click EsperaIE IE, 2000 If i = 2 Then Exit For End If Next link * i = 1 * For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a") * If link.getAttribute("scr") = "../img/exportxls.gif" Then * i = i + 1 * link.Click * EsperaIE IE, 2000 * If i = 2 Then Exit For * End If *Next link End Sub Public Sub EsperaIE(IE As Object, Optional time As Long = 250) 'Código de: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set Dim i As Long Do Sleep time Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _ vbCrLf & vbTab & "Busy: " & CStr(IE.Busy) i = i + 1 Loop Until IE.READYSTATE = 4 Or Not IE.Busy End Sub Function EXTRAIRELEMENTO(Txt As String, n, Separator As String) As String On Error GoTo ErrHandler: EXTRAIRELEMENTO = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1) Exit Function ErrHandler: ' error handling code MsgBox "Erro, veriique os dados de entrada." EXTRAIRELEMENTO = CVErr(xlErrNA) On Error GoTo 0 End Function
  2. Boa tarde! Sou novato e legio na área de programação e estou começando a programar em VBA por necessidade aqui na empresa (estou em busca de cursos para ter algum conhecimento nisso). Um amigo me ajudou a fazer uma planilha similar ao que eu preciso agora para prestadores de serviços de outro setor, mas foi bem mais fácil pois cada peça tinha apenas 2 tipos de valor. Como acabei me enrolando bastante com os códigos, gostaria de pedir ajuda de vocês... Estou tentando criar uma TextBox que seja preenchida automaticamente seguindo os critérios de 3 combobox anteriores a ela. Seria basicamente: Se na ComboBox1 estiver selecionado o Fornecedor1, na combobox2 a Cor Cromado e na combobox3, ao selecionar o produto1 na combobox 4 a TextBoxValor busca o valor do item na Coluna/Linha com preços referente ao fornecedor, produto e cor determinado. Eu travei ao escolher a melhor forma de fazer com que o VBA envie isso pra Plan "Banco de Dados" (e demais destinos)... Fiz um esboço copiando a planilha anterior e anexei aqui no tópico (Link via Mega). Caso alguém tenha uma idéia para facilitar o uso da mesma, estou aberto a sugestões. (Estou preocupado no momento com o Envio de Lotes, pois no recebimento terei um problema ainda maior, uma vez que os Lotes não vem como saem... Os fornecedores misturam lote 1 com lote 2, 3, 4, 5; trazendo cada lote de forma parcial e misturado... Então resolvendo essa parte ainda vou procurar uma solução para isso.) Segue cópia do arquivo: https://mega.nz/#!2O4gASzT
  3. Boa tarde, necessito da vossa ajuda. tenho um código em VBA no access que faz o envio automático de email via outlook. Nesse código, estou a utilizar a função GetBoiler que vai buscar a minha assinatura do outlook: Function GetBoiler(ByVal sFile As String) As String 'Dick Kusleika Dim fso As Object Dim ts As Object Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) GetBoiler = ts.readall ts.Close End Function Mas acontece que a minha assinatura é constituida por texto e por uma imagem. O código vai buscar a assinatura mas não mostra a imagem. Já verifiquei tudo o que tinha de verificar nas "opções" do outlook e está tudo Ok. Até porque se eu envio o email normalmente a assinatura aparece com a imagem. Podem ajudar? Preciso mesmo de resolver esta situação. Obrigado! Segue o código da minha função: Function EnviarMailAutomatico() On Error GoTo EnviarMail_Err Dim objOut As Object Dim objMail As Object Dim msg As String Dim resp As Integer Dim MyFile Dim SigString As String Dim Signature As String Dim Utilizador As String Dim strbody As String Const olMailItem = 0 Const olByValue = 1 Utilizador = UtilizadorRede ' Verifica se a caixa de seleção já está selecionada If Forms!Pedido!Enviado.Value = True Then MsgBox "Desculpe, mas você já enviou este e-mail. " _ & "Não é possível enviar o mesmo e-mail mais " _ & "de uma vez", vbCritical Else 'Retornar o nome do ficheiro da assinatura para o utilizador de rede que está logado no Computador MyFile = Dir("C:\Users\" & Utilizador & "\AppData\Roaming\Microsoft\Signatures\" & "*.htm") ' Confirmar antes de enviar o e-mail. resp = MsgBox("Você está prestes a enviar um e-mail de" _ & " confirmação de despacho. Deseja realmente continuar?", _ vbQuestion + vbYesNo) If resp = vbYes Then ' Cria os objetos Set objOut = CreateObject("Outlook.application") Set objMail = objOut.CreateItem(olMailItem) strbody = "<H3>Caros colegas,</H3>" & _ "Peço que se elimine o pedido número " & Forms!Pedido!Ped & _ ".<br>" & _ "<br><br><B>Obrigado</B>" 'Atribuir a assinatura do remetente SigString = Environ("appdata") & _ "\Microsoft\Signatures\" & _ MyFile If SigString <> "" Then Signature = GetBoiler(SigString) Else Signature = "" End If On Error Resume Next With objMail .BodyFormat = olFormatHTML .To = "teste@teste.pt" .CC = "teste1@teste.pt" .Subject = "Eliminar pedido " & Forms!Pedido!Ped .HTMLBody = strbody & "<br>" & Signature End With ' Envia o e-mail objMail.Display ' Remove os objetos da memória Set objMail = Nothing Set objOut = Nothing End If End If EnviarMailAutomatico_Exit: Exit Function EnviarMailAutomatico_Err: MsgBox Error$ Resume EnviarMail_Exit End Function
  4. Bom dia a todos! Estou tentado utilizar o VBA para realizar um cálculo relativamente extenso, que não se repete (não pode ser feito por loop) e que foi extraído do software matemático Maple(apenas a operação matemática em si, o resto do código eu que fiz). Como o Maple calcula nativamente isso, o resultado que ele devolve é correto, porém, quando eu tento realizar a conta pelo VBA ele me devolve um valor diferente. Tentei algumas alternativas para solucionar o problema porém não tive sorte. Dentre os testes eu: - tentei declarar todas as variáveis "t" das equações como Double. - tentei modificar a expressão no Maple e simplificá-la(mudar as expressões para "t"). - adicionei uma parte do código para conferir se as variáveis que ele utiliza para calcular estão corretas. Eu acredito que algo possa estar fazendo o VBA se perder no meio dessa conta, porém não sei o que. Se alguém puder olhar/ajudar/sugerir algo, ficarei eternamente grato! PS:Entendo um pouco de programação mas não sou programador, então já aviso, meu código pode parecer meio feioso. Tentei anexar o arquivo do VBA aqui mas não consegui. Segue o código abaixo: Private Sub C1() 'Calcula C1 e atribui a B1 da primeira planilha 'Declaração de Variáveis Dim OD As Double, thick As Double, ID As Double Dim E As Double Dim Ine As Double Dim Ei As Double Dim Lm As Double Dim ml As Double, mr As Double Dim rho As Double Dim jr As Double, jl As Double Dim sr As Double, sl As Double Dim Ar As Double Dim Mee As Double Dim re As Double Dim Le As Double Dim Fe As Double Dim beta As Double Dim omega As Double Dim Pi As Double Dim omega_omegan As Double Dim C1 As Double 'Atribuição dos valores 'Na realidade estes valores são extraidos de células do excel, 'para fins demosntrativos eu atribui os valores diretamente OD = 0.22 thick = 0.02 Lm = 6 E = 2 * 10 ^ (11) omega_omegan = 0.8 Pi = 4 * Atn(1) ID = OD - 2 * thick Ine = Pi * (OD ^ (4) - ID ^ (4)) / 64 Ei = E * Ine Ar = Pi * (OD ^ (2) - ID ^ (2)) / 4 rho = 7850 Le = 0.5 beta = 0.617843785182212 Mee = 5 re = 0.2 omega = (beta ^ 2) * (Ei / (rho * Ar)) ^ (1 / 2) Fe = Mee * re * ((omega_omegan * omega) / (2 * Pi)) ^ (2) mr = 200 ml = mr jr = 0 jl = 0 sr = 0 sl = 0 'Exibe os valores que estão sendo usados no cálculo Range("b13").Value = omega Range("b14").Value = beta Range("b15").Value = Ei Range("b16").Value = rho Range("b17").Value = Ar Range("b18").Value = Fe Range("b19").Value = Mee Range("b20").Value = ml Range("b21").Value = mr Range("b22").Value = jl Range("b23").Value = jr Range("b24").Value = sl Range("b25").Value = sr Range("b26").Value = re Range("b27").Value = Le Range("b28").Value = OD Range("b29").Value = ID Range("b30").Value = thick 'Realiza o cálculo de C1 efetivamente t3 = beta * Lm / 2# t4 = WorksheetFunction.Sinh(t3) t5 = sr - Le t7 = sr * t5 * mr t8 = t7 + jr t11 = Sin(t3) t12 = ml * t11 t13 = WorksheetFunction.Cosh(t3) t17 = Cos(t3) t19 = t4 * t4 t23 = beta * beta t24 = t23 * beta t25 = t23 * t23 t26 = t25 * t24 t30 = mr * t5 t31 = t13 * t13 t35 = sl * sl t36 = ml * t35 t38 = (t36 + jl) * rho t48 = t25 * t23 t50 = sl * t5 t51 = sl + sr t54 = sl * jr t55 = jl * Le t58 = jl * mr t59 = t58 * t5 t62 = rho * t17 t63 = t62 * t31 t77 = t5 * t51 * mr t78 = t77 + jr t83 = t62 * t19 t86 = t25 * beta t92 = Ar * Le t95 = jl / 2# t107 = Ar * rho t112 = sl + Le t114 = sl * t112 * ml t116 = Ar * Ar t118 = rho * rho t119 = t118 * t17 t125 = jr / 2# t129 = ml * mr t146 = ml * t112 t149 = sl * ml t159 = t116 * t118 t172 = t116 * Ar t173 = t118 * rho t174 = t172 * t173 t192 = jl * jr t193 = t17 * t17 t204 = t25 * t25 t206 = sr * sr t209 = -jl * t206 - jr * t35 t213 = t192 * mr t214 = (t209 * mr - t192) * ml - t213 t216 = t214 * t11 * Ar t226 = t107 * t13 t232 = t4 * t11 t233 = mr * t206 t255 = ((sr * t51 * mr + jr) * sl * ml + t58 * sr) * Ar * rho t257 = jl + jr t258 = t129 * t257 t259 = -2# * t255 - t258 t261 = t259 * t11 * Ar t272 = t51 * t51 t273 = t272 * mr t282 = 2# * ((t273 + t95 + jr) * ml + (jl + t125) * mr) * t116 * t118 * t193 t305 = Ar * (t36 + t233 + jl + jr) * rho + 2# * t129 * t51 t307 = t305 * t116 * t118 t308 = t11 * t17 t309 = t308 * t31 t311 = t305 * Ar t320 = t308 * t19 t335 = ml + mr t336 = t174 * t335 t349 = t116 * t116 t350 = t118 * t118 t351 = t349 * t350 C1 = -Fe * Ar * ((t8 * jl * ml * t17 * t19 - t4 * t8 * jl * t12 * t13) * t26 + (-t11 * jl * ml * t30 * t31 - t4 * (-2# * t8 * Ar * t38 - jl * ml * t30) * t17 * t13) * t48 + (-((-t50 * t51 * mr - t54 + t55) * ml - t59) * Ar * t63 + 2# * t4 * ml * Ar * (sl * sr * t30 + t55 / 2# + t54) * rho * t11 * t13 + (sl * t78 * ml + t59) * Ar * t83) * t86 + (t12 * Ar * t78 * rho * t31 - 2# * t4 * (t92 * t38 - ml * (t50 * mr - t95)) * Ar * t62 * t13 + t11 * (t77 + jl + jr) * ml * t107 * t19) * t25 + (-(t114 + t7 + jl + jr) * t116 * t119 * t31 - 2# * t4 * ((Le * ml * sl - t7 / 2# - t125) * Ar * rho - t129 * t5) * Ar * rho * t11 * t13 - (t114 + jl) * t116 * t119 * t19) * t24 + (-t11 * t116 * t118 * t146 * t31 - 2# * t4 * (t149 + t30 / 2#) * t116 * t119 * t13 - t11 * (t146 - t30) * t159 * t19) * t23 + (-t4 * t116 * t118 * (t92 * rho + 2# * ml) * t11 * _ t13 + t174 * Le * t17 * t19) * beta + t172 * t17 * t13 * t4 * t173 - t172 * t11 * t31 * t173) * rho / t24 / Ei / (((t192 * t129 * t193 - t192 * t129) * t31 + t192 * ml * mr * t193 * t19) * t204 + (-t216 * t63 - 2# * t4 * (t214 * t193 + (-t209 * mr / 2# + t192 / 2#) * ml + t213 / 2#) * t226 - t216 * t83) * t26 - 4# * t232 * (-Ar * (t233 + jr) * t38 - t129 * (jl * sr + t54)) * t17 * t107 * t13 * t48 + (-t261 * t63 - 2# * t4 * (-t259 * t193 - t255 - t258 / 2#) * t226 - t261 * t83) * t86 + ((-t282 + ((t273 + jr) * ml + t58) * t116 * t118) * t31 + (-t282 + ((t273 + jl + jr) * ml + mr * t257) * t116 * t118) * t19) * t25 + (-t307 * t309 - 2# * t4 * (t311 * rho * t193 - t311 * rho / 2#) * t226 - t307 * t320) * t24 - 4# * t232 * (Ar * (mr * sr + t149) * rho + t129) * t116 * t119 * t13 * t23 + (-t336 * t309 - 2# * t4 * (-t159 * t335 * t193 + t159 * t335 / 2#) * t226 - t336 * t320) * beta + (t351 * t193 - t351) * t31 + t349 * t193 * t19 * t350) / 2# 'Atribui C1 a célula B1 da primeira planilha Worksheets(1).Range("b1") = C1 End Sub
  5. menezes7

    Função VLookUP

    Olá,Tenho um arquivo com duas planilhas ("Planilha1" e "Planinha2"). Na planilha1, tem uma tabela "A1:O2" (2 linhas, 14 colunas), sendo a primeira linha o cabeçalho.Estou tentando inserir um código que atualize o valor de cada célula da linha 2 com um procv com base no valor inserido na célula imediatamente anterior a ela, porém está gerando erro. O procv busca o valor na planilha2 Segue código: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i, j As Integer Dim TabelaFonte As Range i = Target.Column j = 3 TabelaFonte = Application.Sheets("Planilha4").Range(Cells(3, 119 + j - 1), Cells(2649, 148)) If Not Intersect(Target, Range("B2:O2")) Is Nothing Then For j = i + 1 To 14 Cells(2, j).Value = Application.WorksheetFunction.VLookup(Cells(2, j - 1).Value, TabelaFonte, 2, False) Next End If End Sub O link do arquivo é o: https://www.sendspace.com/file/ixo3qd
  6. Olá, Tenho uma tabela 2x4, sendo a primeira linha o header. A opção de valores para preenchimento das células no intervalo B2:O2 está disponível em uma lista de validação de dados. A lista disponível em cada célula varia de acordo com o valor selecionado nas células anteriores. Assim, as opções disponíveis na célula D2 dependem do valor selecionado na célula C2, que depende do valor selecionado na célula B2 e assim sucessivamente. Gostaria de criar uma macro que: 1- Preencha automaticamente o valor de uma célula conforme o valor escolhido nas células anteriores. Esse valor deve estar previamente previsto como opção na lista de validação de dados. O arquivo está disponível no link: https://www.sendspace.com/file/b4wwog
  7. Fala Galera,Estou tentando resolver um código e, por ser leigo no assunto, tenho penado esses dias.A ideia é a seguinte:Tenho uma planilha (workbook) no excel que é abastecida diariamente com centenas de lotes de produtos. Todos esses lotes tem um prazo de aprovação.Estou tentando criar uma planilha (outro workbook) para funcionar como central de avaliação de prazos por meio de macros.A planilha possui dois botões: no primeiro, seleciono o workbook o qual será avaliado de acordo com os prazos (pode ser matéria-prima, embalagem, etc). Esse botão retorna o endereço da planilha de avaliação, a qual é selecionada com um opendialog, na célula F5 da "central de avaliação".O segundo botão, a intenção é que ele faça uma varredura na coluna "datas" da planilha apresentada em "F5", copie as datas que estão próximas ao vencimento (menos de 4 dias) e cole na "central de avaliação" na unica aba existente.Deu pra entender?Até agora, o código que eu cheguei está apresentado abaixo. O primeiro botão funciona perfeitamente, já o segundo, seleciona as datas mas apenas cria um filtro na planilha de origem dos dados e não cola na planilha central. Sub copiarClick() 'teste novo Dim rawDataSht As Worksheet, filtDataSht As Worksheet Dim pasta As String Dim wbOrigem As Workbook Dim wbDestino As Workbook 'Identificação caminho pasta e conferencia do preenchimento If Range("F5").Value <> "" Then pasta = Range("F5").Value Else MsgBox "Selecionar planilha para avaliação." Exit Sub End If Set wbDestino = ThisWorkbook Workbooks.Open (pasta) Set wbOrigem = Workbooks.Open(pasta) With wbOrigem AutoFilterMode = False With Range("M2", Range("M" & Rows.Count).End(xlUp)) .AutoFilter Field:=1, Criteria1:=Array("1", "2", "3", "4") On Error Resume Next .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy End With wbDestino.Sheets("Liberação").Cells(2, 2).PasteSpecial xlPasteValues .AutoFilterMode = False Application.CutCopyMode = False End With wbOrigem.Close (True) End Sub Alguém tem alguma dica?Desde já agradeço.Abraço
  8. Bom dia a todos. Tenho um arquivo excel que extrai dados do BD SQL através de uma macro em VBE, esta macro calcula o "saldo atual" do item consultado na Query, o que preciso é que quando o resultado desta soma for igual a 0 (zero) não seja apresentado o resultado da Query. Não sei se fui claro, não sou programador, sou apenas apaixonado por Excel e VBA, vou exemplificar o que preciso: Resultado atual da minha query: Item Descrição Saldo abcd Item1 43,65 bcd Item2 0,00 dcba Item3 1,00 Resultado desejado: Item Descrição Saldo abcd Item1 43,65 dcba Item3 1,00 A instrução SQL que estou utilizando é: StrQuery = "SELECT distinct a.cd_item,c.descricao,sdoatual=(a.qt_entrada - a.qt_saida) FROM (vSaldoItem a INNER JOIN vSaldoItemdia b ON a.cd_item = b.cd_item AND a.cd_deposito = " & "'" & dep & "'" & ") INNER JOIN Item c ON a.cd_item = c.cd_item order by a.cd_item" Agradeço a ajuda Dúvida postada, sob o mesmo título, nos forums: Comunidade do Hardware – hardware.com.br Guru do Excel – gurudoexcel.com
  9. Bom dia pessoal, Tenho o código para abrir e navegar na web, porem que navegar a uma determinada web e capturar os dados de sua id e baixar para o excel de forma organizada. Fiz varias pesquisas e não encontrei um exemplo para que eu possa tentar fazer sozinho, assim que peço a ajuda de vocês para executar esse projeto. Vou deixar o exemplo feito manual de como deveria ficar no excel para que me entenda. Desde já agradeço. Link da web para pegar os dados https://economia.uol.com.br/cotacoes/cambio/dolar-comercial-estados-unidos/ Dados da web com id Exemplo de como ficaria Código Sub Automate_IE_Load_Page() 'This will load a webpage in IE Dim i As Long Dim URL As String Dim IE As Object Dim objElement As Object Dim objCollection As Object 'Criar objeto do InternetExplorer Set IE = CreateObject("InternetExplorer.Application") 'Set IE.Visible = True para tornar o IE visível, ou False for IE para executar em segundo plano IE.Visible = True 'Define URL URL = "http://www.planilhando.com.br/" 'Navigate to URL IE.Navigate URL ' Statusbar permite que o usuário conheça o site está carregando Application.StatusBar = URL & " is loading. Please wait..." ' Aguarde enquanto o IE está carregando ... 'IE ReadyState = 4 significa que a página web foi carregada (o primeiro loop está configurado para evitar ignorar inadvertidamente o segundo loop) Do While IE.ReadyState = 4: DoEvents: Loop 'Do While Do Until IE.ReadyState = 4: DoEvents: Loop 'Do Until 'Página carregada Application.StatusBar = URL & " Loaded" 'Unload IE Set IE = Nothing Set objElement = Nothing Set objCollection = Nothing End Sub
  10. Pessoal, tenho um form com uma picturebox que contem um gif de loading. Estou tentando fazer com que antes de executar um método ele exiba essa imagem de carregando e feche quando terminar. ele até funciona mas em determinado momento conforme o uso ele me retorna o erro: An unhandled exception of type 'System.Threading.ThreadAbortException' occurred in System.Drawing.dll Additional information: O thread estava sendo anulado. Public Class clsModoCarregando Dim FrmLoading As New Loading Dim trdelegate As New ThreadStart(AddressOf carregarFormLoading) Dim trd As New Thread(trdelegate) Private Sub carregarFormLoading() Try FrmLoading.ShowDialog() Catch ex As ThreadAbortException Thread.ResetAbort() End Try End Sub Public Sub ExibirLoad() If Not trd.IsAlive Then trd.Name = "threadCarregando" trd.IsBackground = True trd.Start() End If End Sub Public Sub FecharLoad() If trd.IsAlive Then trd.Abort() trd.Join() End If End Sub End Class 'evento do botao pesquisar do form Private Sub btnPesquisar_Click(sender As Object, e As EventArgs) Handles btnPesquisar.Click Dim ModoCarregando As New Ambiente.clsModoCarregando If lstConsulta.Items.Count > 0 Then ModoCarregando.ExibirLoad() dtgPesquisa.DataSource = insPesquisa.pesquisar(lstConsulta, dtNomesPesquisa.Rows(0)("Tabela")) dtgPesquisa.DataMember = dtNomesPesquisa.Rows(0)("Tabela") ModoCarregando.FecharLoad() Else If txtValorPesquisa.Text = String.Empty Then MsgBox("informe o valor a ser pesquisado.", vbInformation) txtValorPesquisa.Focus() Else MsgBox("Adicione a consulta antes de pesquisar.", vbInformation) btnAdicionar.Focus() End If End If End Sub
  11. Boa noite. Estou com uma dificuldade extrema. Tenho uma macro que funcionou por vários anos. De uma hora para outra, ela não consegue colar os dados e dá a famigerada mensagem: Erro 1004 - o método pastespecial da classe range falhou O problema é que se eu fizer manual (ctrl+c - crtl+v), também não funciona, só não dá mensagem nenhuma. Porém, se eu escrever manualmente na planilha ela aceita. Eis a parte do código que dá problema. Plan8.Select ActiveSheet.Unprotect Range("b505:H505").Select Selection.Copy Range("a18").Select Plan1.Select ActiveSheet.Unprotect Range("b100000").End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Protect quando chega no selection.pastespecial trava e não vai de jeito nenhum. Já tentei em dois computadores, já fiz manual, não funciona. Não sei mais o que fazer. O problema é que é um arquivo importante para mim. Se alguém puder me ajudar eu agradeço.
  12. wandersonlw

    Programa para PCP

    Olá sou funcionário de uma empresa onde a produção está uma zona, eu queria tentar arrumar a produção, tenho algumas idéias eu não tenho dinheiro pra pagar um programador, se alguém poder me ajudar de forma voluntária a desenvolver um programa de controle de produção agradeço muito.
  13. Pessoal, preciso de freela que possa nos ajudar a transformar planilhas dinamicas Excel em mini aplicativos C objetivo: criar banco de dados de referencias pesquisar movimentações de dados e incrementar rotinas preditivas desejavel conhecimmento vba e linguagem c pode ser c++ conhecimentos em banco de dados interessados pode me contatar aqui ou no w app 11 95916 7597 sucesso a todos
  14. Estamos desenvolvendo um projeto mobile com c++, inovação que necessita de ajuda especializada. Em fato iremos transpor planilhas Excel VBA macro para alocar em modulo c++ protegido, com vistas a ceder informações com melhor controle do gestor, mais facilidade de acesso aos usuários funções incluirão mudar a linguagem dos cálculos excel para c++, implantação de funcionalidades web em servidor, transposição vba para c++ e criação de bd cloud criar plataforma com registro mac para acesso controlado dos usuários disponibilizar acessos a mobile e computadores depois desse serviço poderão existir outros, uma vez que temos muitas planilhas Excel para serem adaptadas ao novo molde. (temos uma escola e pretendemos colocar as informações didáticas com mais facilidade a nossos alunos) (por favor me retorne com alguns exemplos de serviços que tenha realizado). Queremos iniciar o projeto imediatamente. obrigado Felipe Klein CONTATO 11 95916 7597 W APP
  15. Boa tarde a todos, Tenho experiência mediana no VBA mas sou novo no Access. Uma vez preenchido um campo em um formulário, preciso levar essa informação para um campo de uma outra tabela - no registro cuja chave primária eu tenho naquele formulário citado. Já fiz várias tentativas, busquei várias opções na internet mas não consegui ter sucesso. Alguém pode me dar uma dica de como fazê-lo? Em termos simplórios, seria como um dlookup mas "invertido", pois não quero trazer mas sim levar o valor para outra tabela. Muito obrigado!
  16. Boa noite, Prezados, criei um arquivo de mala direta com mais de 1000 fotos, porém as fotos não atualizaram sua referência. Preciso clicar em cima de cada uma e apertar “F9” para atualizar a foto. Se seleciono o texto todo (ctrl+t) e aperto "F9" o word trava. Queria criar uma macro para atualizar todas as imagens de uma só vez. Quando gravo sei que a função para atualizar fica "Selection.Fields.Update" E achei uma macro que roda em todas as imagens diminuído o tamanho, porém não atualiza a referencia. Queria que em vez de diminuir o tamanho ela atualizasse a foto. Segue a macro de edição de tamanho. Sub Macro1() Dim insertedPicture As InlineShape Dim insertedShape As Shape Dim imgMult As Single imgMult = Fields.Update For Each insertedPicture In ActiveDocument.InlineShapes insertedPicture.Select insertedPicture.Width = insertedPicture.Width * imgMult / insertedPicture.Height insertedPicture.Height = imgMult Next End Sub Queria adaptar para atualizar a imagem “ Selection.Fields.Update “ Obrigado!
  17. Olá, pessoas... Gostaria de uma ajudinha com um TexBox no CorelDRAW... mais precisamente eu gostaria de atualizar automaticamente uma TextBox a partir de uma ListBox, ou seja, na ListBox existem opções que precisam de valores distintos entre si para ser exibido no TextBox quando for selecionado... Caso alguém puder auxiliar, eu agradeço de antemão...
  18. Olha, estou precisando montar uma planilha em excel e acredito que algumas funcionalidades dela deverão ser implementadas em VBA e eu não manjo disso, poderiam me ajudar? Eu estou fazendo uma planilha (conforme imagem anexo) para acompanhar datas de conclusão de várias atividades. Eu preciso registrar o cliente e uma data prevista para uma migração. Com base nessa data, existem outras atividades que devem ser executadas antes, excluindo os finais de semana e feriados. Para isso utilizei a formula =DIATRABALHO.INTL. Também fiz uma formatação condicional com base na data. Se a data < hoje() formata em verde, se data =hoje() formata em amarelo, etc. Agora vem a parte que não consigo fazer... Nas celulas ao lado de cada data coloquei uma lista suspensa com as opções "-" e "OK". Preciso fazer com que no momento que o usuário selecionar OK na celula com a data prevista para aquela atividade (exemplo: N17=OK; M17= Dia que foi alterada a celula N17) mude para a data atual e retire a formatação, e volte para a condição anterior caso o usuário retorne a selação para "-"
  19. megsp

    Campo de Pesquisa

    Bom dia pessoal. Como faço para criar um campo de pesquisa no formulário Access que permita dados com letras e números? Ex: pesquisar o item ABC12345678.
  20. Tenho o seguinte código que me faz a consulta e me retorna o valor inserido com base na minha pesquisa.O meu problema é o seguinte:eu tenho na minha tabela os seguintes valores:Descrição -- Código ---- IDteste1 - - ABC1 ---- 1teste2 - - ABC2 ---- 2 teste3 - - ABC3 ----- 3teste1 - - ABC4 ---- 4teste1 - - ABC5 ----- 5teste1 - - ABC6 ----- 6O que eu preciso é que com base no meu código de busca, adaptar para que ele me retorne os 3 últimos valores lançados na tabela de acordo com minha descrição.Nesse caso ficaria assim:Ao realizar a pesquisa: "teste1"me retorno os valores:Textbox1 = ABC6Textbox2 = ABC5Textbox3 = ABC4 ' Dim valor_pesq As String Dim ComandoSQL As String valor_pesq = Me.cmb_material ComandoSQL = "select * from TB_Valores where Material_Desc like '*" & valor_pesq & "*' " ' 'Chama a rotina que faz a conexão com o BD Call Conecta 'Atribui a variável objeto de BD a execução dos comandos SQL Set consulta = banco.OpenRecordset(ComandoSQL) 'Tratamento de erro de acesso aos dados. Se houver erro, desvia o comando para o rótulo Sai On Error Resume Next 'Tratamento de erro de acesso aos dados. Se houver erro, desvia o comando para o rótulo Sai ' On Error GoTo sai Me.txt_DI = consulta("DI") txt_custo_forn1 = consulta("Valor_Unit") & "" consulta.Update Call Desconecta End Sub
  21. Bom dia, estou com um problema e não consigo resolver, já tentei de tudo. Bom, envio emails uma vez por semana, posso ter de 3 a 160 correspondentes. eu criei a query porem não consigo anexar a ela o corpo de email. alguém pode me ajudar? segue codigo. estou enviando o referente a um cliente, eu só replico o código varias vezes. ActiveSheet.Range("$A$1:$M$1694").AutoFilter Field:=10, Criteria1:= _ "LJ_BA_SALVADOR_AEROPORTO" Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Range("A1:M1700").Select Selection.Copy ChDir "C:\Users\rodolfo.ribas\Desktop\Testes_Email" Workbooks.Open Filename:= _ "C:\Users\rodolfo.ribas\Desktop\Testes_Email\LJ_BA_SALVADOR_AEROPORTO.xlsm"
  22. ERRO 1004: Método Select da classe Range falhou. Eu só queria salvar as informações adquiridas do teclado na planilha! Mas estou fazendo alguma burrada! estou no desespero!! Quem puder ajudar, agradeço! Segue o código: Private Sub btsalvainfos_Click() ActiveWorkbook.Worksheets("Plan1").Select Selection.EntireRow.Insert Plan1.Cells(3, 1) = Me.ComboBox1.Text Plan1.Cells(3, 2) = Me.TextTAREFA.Text Plan1.Cells(3, 3) = Me.TextRESP.Text Plan1.Cells(3, 4) = Me.TextPRAZO.Text Plan1.Cells(3, 5) = Me.TextDIF.Text Plan1.Cells(3, 6) = Me.ComboBox2.Text Me.ComboBox1 = Empty Me.TextTAREFA = Empty Me.TextRESP = Empty Me.TextPRAZO = Empty Me.TextDIF = Empty Me.ComboBox2 = Empty ComboBox1.SetFocus End Sub
  23. Boa dia, Uma vez criei um botão no meu BD que abria uma pasta dentro do Drive da empresa. O nome dessa pasta era a matricula do funcionário, por onde eu fazia o link. Utilizei o código abaixo: Dim dossie As String dossie = "explorer.exe P:\Interna\EQUIPE\DOSSIES\" & Me.txtmatricula & "\" Shell dossie, vbNormalFocus Contudo, dessa vez preciso abrir uma pasta com a matrícula do funcionário, mas ela está dentro de um arquivo zipado. Além disso, por serem arquivos grandes eles estão divididos pelo primeiro número da matrícula (Ex: todas as matrículas começadas por "0" estão dentro da pasta "Matrículas 0", que é a pasta zipada) Seria possível fazer algo do tipo?
  24. Bom dia!! Preciso que ao clicar duas vezes em uma área específica da planilha seja executada uma determinada macro, o problema é que tenho duas áreas distintas que deverão executar macros distintas. Com o doubleclick consigo acionar a macro em apenas uma área, por exemplo área ("B4:B" & Lastrow), ocorre que preciso utilizar a área ("C4:C" & Lastrow) para executar outra macro. Já tentei utilizar SELECT CASE com o Doubleclick e não funcionou, meu conhecimento de VBA é limitado e não sei como resolver este caso. Utilizei o Doubleclick por pura analogia de necessidade, clicar duas vezes em uma área específica para acionar outra macro, mas se para o meu caso a solução for outra agradeço se me orientarem. Abaixo segue a macro que estou utilizando: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim LastRow As Long With ActiveSheet LastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Offset(-1, 0).Row End With If Intersect(Target, Range("B4:B" & LastRow)) Is Nothing Then Else MsgBox ("CR Funcionou") End If Application.SendKeys "{ESCAPE}" End Sub Anexo estou enviando a imagem da planilha do excel onde tenho as informações onde será executado o doubleclick, posso enviar o arquivo que é simples e pequeno, na verdade este arquivo é parte de outro maior com outras macros mas que para facilitar deixei apenas a planilha e a macro que estou com dificuldades. Grato
  25. Tentei colocar 2 index na tabela mas só funcona o 1°(Cadastro) 2°(Nome) mesmo que eu mude o (DataCadastro.Recordset.FindFirst "Cadastro >= '" & txtPesquisa & "'") para (DataCadastro.Recordset.FindFirst "Nome >= '" & txtPesquisa & "'") Porque o que tenho que fazer pra funcionar os 2(Cadastro e o Nome )? Olá tenho uma txtPesquisa_Change que faz pesquia dinamica pelo codigo do cliente mas gostaria que Pesquisa-se pelo nome tmbm como faço segue codigo abaixo lembrando estou com DAO e usando DATA Private Sub txtPesquisa_Change() 'Busca Dinamica DataCadastro.Recordset.FindFirst "Cadastro >= '" & txtPesquisa & "'" If DataCadastro.Recordset.NoMatch Then MsgBox "Não encontrado" Else End If End Sub
×
×
  • Criar Novo...