Search the Community

Boas Estou com algumas dificuldades em fazer um código para ver se a célula contem ou não uma string alguém me poderia ajudar. Obrigado, Afonso Mira

Boa tarde tenho o seguinte esquema: Folha Excel com Dados ----- Excel com Macro ----- Folha Excel recebe Dados Precisava de passar os dados da 1º folha para a 2º quando abro o Excel que contêm a macro. Alguém me poderia dar uma ideia do código que vou precisar? Obrigado!😄 Abraços, Afonso Mira.

Oi pessoal estou com um problema que não consigo resolver. O que eu queria fazer era o seguinte: Sempre que o valor constante linha 16 for igual ao valor da linha 9, a macro executasse automaticamente, ou seja, enviando um e-mail com a informação, segue eu precisasse digitar o valor na linha. Obs.: A linha 9 é uma fórmula, ou seja, não digito o valor. Na linha 16, o valor é digitado e quando o valor da linha 9 (que é fórmula) atingir automaticamente o valor da linha 16, o e-mail é disparado. Segue abaixo a macro que de estou tentando resolver o problema: Private Sub Worksheet_Change(ByVal Target As Range) Dim OutApp As Object Dim OutMail As Object Dim texto As String Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) linha = Target.Row If Target.Address = "$I$" & linha Then If Planilha11.Cells(linha, 16) = Planilha11.Cells(linha, 9) Then With OutMail .To = "xxxxxxxxx@gmail.com" .CC = "" .BCC = "" .Subject = " A Ação " & Planilha11.Cells(linha, 1) & "," & " atingiu o valor " & Planilha11.Cells(linha, 16) .Body = texto .Send 'Utilize Send para enviar o email sem abrir o Outlook End With End If On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End If End Sub

Boa tarde, Precisava da vossa ajuda, se fosse possível, para o seguinte : Tenho um livro excel com 3 folhas (cadorc, orcamento e Sheet 1). Queria copiar dados da folha orçamento para a Sheet1. O meu problema é que por cada novo orçamento os dados da folha orcamento são apagados. Queria que a Sheet1 fosse a base de dados de todos os orçamentos , ou seja , queria copiar os dados para esta sem apagar os anteriores. Tenho uma rotina que ,embora lenta, faz a copia. Problema é qua apaga os dados anteriores, isso não queria!!! Agradeço a ajuda

Boa noite. Tenho um ficheiro que criei no excel 2010 e que gera um pdf a partir do nome original do ficheiro, adicionando a data obtida a partir da céluda A2, como prefixo. Este ficheiro sempre correu bem até actualizar o pc para o excel2016. Deixou de gerar o pdf e dá sempre erro no VBA for Applications, na função cujo código passo a apresentar: Worksheets("Envio Cliente").Activate Dim data2 As String pdfName = ActiveSheet.Name data2 = ActiveSheet.Range("A2").Value pdfName = "_Mapa de Contagem" MsgBox data2 ChDir ActiveWorkbook.Path & "\" fileSaveName = data2 & pdfname ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ fileSaveName _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Aque MsgBox serviu para perceber qual seria o valor que estaria a ser lido na célula A2 e é sempre dd/mm/yyyy o que faz com que não possa ser usado para nome de ficheiro. Já tentei formatar a data no excel de todas as formas, desde pontos a hifenes. Retorna sempre aquele valor com as barras. Já andei a tentar ver se há algum workaround, mas não consegui nada. Se alguém tiver alguma sugestão, agradeço.

Trabalho numa multinacional, onde temos Excel em Inglês e em Português. A função EOMONTH funciona bem no inglês e quando se abre no português é automaticamente convertida para FIMMES. O Problema é quando se volta a abrir o ficheiro no Excel inglês, a conversão não acontece e fica a dar aquele erro de função #NAME? Já alguém passou por isso? Alguma ideia?

Saudações Caríssimos. Estou pronto a terminar um projecto de Sistema de Facturação, e Gestão Empresarial, e estou tendo problemas ao adicionar um rdlc que é a uma extensão do Visual Studio, para relatórios e impressão. Eu não tenho instalado ele, eu apenas tenho a extensão crystal report, mais não trabalhar com ele... Agradeço desde já, eu não acho a extensão a lugar algum para a versão do Visual Studio 2010 Ultimate ou Express. Obrigado

Tenho o código abaixo que acessa a página da InfoMoney e seleciona a opção Todos do botão para retornar todos os resultados. O problema é que só seleciona, mas não clica para retornar todas as cotações. Sub GetHtmlDocument() Dim IE As New SHDocVw.InternetExplorer Dim HTMLDoc As MSHTML.HTMLDocument Dim HTMLOptions As MSHTML.IHTMLElementCollection Dim HTMLOption As MSHTML.IHTMLElement IE.Visible = True IE.navigate "https://www.infomoney.com.br/ibovespa" Do While IE.ReadyState <> READYSTATE_COMPLETE Loop Set HTMLDoc = IE.Document Set HTMLOptions = HTMLDoc.getElementsByTagName("option") 'É um botão For Each HTMLOption In HTMLOptions If HTMLOption.innerText = "Todos" Then HTMLOption.Selected = True Exit Sub End If Next HTMLOption End Sub

Boas gostaria de criar um vba onde classifica os slides de um powerpoint em ordem alfabética de acordo com o shape(1) de cada slide. Pensei em exportar as Shapes(1) para um arquivo em excel na coluna A e na coluna B numerar de acordo com os slides classificar a coluna A e após isso, reorganizar os slides do powerpoint de acordo com essa lista. Alguem pode me ajudar.

Bom dia. Numa planilha tenho uma macro, a qual quero que corra apenas se a célula ativa se encontrar numa determinada coluna (a coluna "E"). Caso contrário, irá devolver-me uma msgbox. No entanto, ao correr a macro, recebo sempre o erro "run-time error 438". O código que estou a inserir é o seguinte: Sub Macro3() If ActiveCell.Columm <> 5 Then MsgBox "Por favor selecione apenas células da coluna 'Saída'" Exit Sub Else ActiveCell.Offset(0, -1) = ActiveCell.Offset(0, -1) - ActiveCell ActiveCell = 0 End If End Sub Será que alguém me consegue ajudar e dizer o que estou a fazer mal? Muito obrigado, Abraços, Miguel Martins

Boa noite companheiros, Recorro a vocês no sentido de me ajudarem, porque devido ao cansaço já não consigo raciocinar. O assunto é o seguinte, tenho uma tabela de materiais, e depois uma tabela linha de materais. Acontece que para preencher as mesmas, tenho um form, e um sub form (continuo) para a das linhas. O problema é que no subform na combo ondo escolho o material que devera ir para a requisição, depois coloco a qtd, e gostaria de à frente desta me fosse mostrado o stock disponível, numa texbox que irá ler na tabela das linhas, sendo filtrado o stock do que anteriormente escolhemos na combo. Este código deverá ser colocado no evento da combo "after update". Mas emperrei por já levo umas horas boas disto, o meu código até agora não funciona, mas julgo estar próximo. Deixo à vossa apreciação e critica. <>Private Sub Material_AfterUpdate() <>Dim rs As Recordset, s As Long <>Set rs = CurrentDb.OpenRecordset("select Sum(Qtd_Movimentada) AS s from [T_Linhas_EPI]" & _ <> " where material='" & Me.Parent.SF_Linhas_EPI.Material & "';") <>Me.Stock = s <>End Sub Sempre que escolho o material na combo dá run-time error 2465. Abraço a todos e bem hajam

Bom dia , estou a trabalhar num projeto no qual preciso de receber informação de diferentes ESP8266 e através de uma aplicação trabalhar esses dados . Estou a pensar em fazer utilizando Sockets ,ja procurei bastante e tenho um código fucnional , mas que apenas recebe informação de um cliente.E queria saber se alguem me pode ajudar a saber que alteração posso fazer a este código de forma a receber dados de mais de uma ESP. O código base da comunicação é o seguinte: Imports System.Net Imports System.Net.Sockets Imports System.IO Imports System.Text Imports System.Threading Public Class Form1 Dim TCPServer As Socket Dim TCPListener As TcpListener Dim ip As String 'Public ipserver As IPAddress = IPAddress.Parse("127.0.0.1") Public IsListening As Boolean = True Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load TCPListener = New TcpListener(IPAddress.Any, 80) 'esp TCPListener.Start() TCPServer = TCPListener.AcceptSocket TCPServer.Blocking = False Timer1.Enabled = True End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick Try Dim Rcvbytes(TCPServer.ReceiveBufferSize) As Byte TCPServer.Receive(Rcvbytes) TextBox2.Text = (System.Text.Encoding.ASCII.GetString(Rcvbytes)) Catch ex As Exception End Try End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim sendbytes() As Byte = (System.Text.Encoding.ASCII.GetBytes(TextBox1.Text)) TCPServer.Send(sendbytes) TextBox1.Clear() End Sub End Class Obrigado;)

Como consigo programar estes botões que são criados dinamicamente ? Ou informação sobre criação de botões dinâmicos Private Sub compra_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.Width = pagina_inicial.Width - 1 Me.Height = pagina_inicial.Height - 1 Dim objConexao As SqlClient.SqlConnection objConexao = New SqlClient.SqlConnection() objConexao.Open() '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Dim num_total_pedidos As Integer Dim sql As New SqlCommand("SELECT count (*) FROM tbl_pedidos", objConexao) num_total_pedidos = sql.ExecuteScalar() Dim i, k, x, y As Integer x = 63 y = 20 For i = 1 To num_total_pedidos ' For k = 1 To 4 Dim btn As New Button ' btn.Location = New Point(x, y) btn.Width = 100 btn.Height = 100 btn.Text = "" btn.Visible = True FlowLayoutPanel1.Controls.Add(btn) btn.Name = "btn" & i MsgBox("btn" & i) ' x = x + 150 ' Next ' x = 63 ' y = 150 Next objConexao.Close() End Sub

Boa tarde amigos, gostava de saber o que e como faço para que o excel envie um e-mail quando estiver a 5 dias de atingir a data de validade do meu produto. Não consigo achar tutoriais na internet. O meu programa avisa quando faltam 5 dias para a inspeção de uma viatura. Mas gostava que ele avisasse por e-mail. http://www.mediafire.com/file/3ca2f4s4e2phtk2/Alerta_de_Inspe%C3%A7%C3%B5es.xlsm/file

Boa noite, Estou a começar a mexer no VBA, contudo não tenho qualquer tipo de bases. E neste momento pelo pouco que entendo, estou a precisar de criar uma macro que a sua linha de codigo faça com que ao clicar no botao criado a numeraçao seja automatica aumentado um numero ao numero que ja la estava. Sendo mais especifico, criei um documento(fatura) e precisava de fazer um botao que ao clicar limpa-se o documento escrito e aumenta-se o numero da fatura, para escrever a fatura seguinte. Deste modo, precisar de programar algo que me fizesse isso da numeraçao automatica e da gravação, o problema é que não entendo nada do assunto e tudo que procurei não me serviu de muito. Obrigado pela atenção, Vitor Costa

Boa Tarde, Estou tentando criar um código que, ao colar um nome na coluna D, percorra a coluna D e procura esse valor nas celulas anteriores, depois copie os valores das celulas da mesma linha da celula encontrada para a linha que está o nome que eu colei inicialmente. Por exemplo, eu digito o nome "João" na celula D100, o programa procura o nome da celula D1 até a ultima celula. Supondo que ele encontrou o nome na celula D35, ele copia a celula I35 e P35 e cola nas celulas I100 e P100 Aqui está o que eu tentei, mas não tive sucesso: Dim UltCel As Range Dim lastcel As Range Dim Nome As String Dim Area As String Dim Nome2 As String Range("A37").Select Selection.End(xlUp).Select 'Loop principal 'percorrer os nomes Do While ActiveCell.Value <> "CLIENTE" 'guardar o nome Nome = ActiveCell.Value Set UltCel = ActiveCell Range("A1").Select 'repetição Do While ActiveCell <> "CLIENTE" Nome2 = ActiveCell.Value Set lastcel = ActiveCell If Nome2 = Nome Then 'If ActiveCell.Offset(0, 1).Value <> "" Then ActiveCell.Offset(0, 2) = Nome 'End If End If ActiveCell.Offset(1, 0).Select Loop Exit Do UltCel.Offset(-1, 0).Select Loop

Boa tarde, Estou a ter este erro mas não sei a razão: Private Sub btn_abredesenhos_Click(sender As System.Object, e As System.EventArgs) Handles btn_abredesenhos.Click Dim doc = XDocument.Load("cl.xml") Dim folderToFind = "ov" + TextBox_ov.Text Dim paths = doc.Descendants("dir").Where(Function(dir) String.Equals(folderToFind, CStr(dir.Attribute("name")), StringComparison.OrdinalIgnoreCase)).[Select](Function(dir) dir.AncestorsAndSelf().[Select](Function(el) CStr(el.Attribute("name"))).Reverse().Aggregate(String.Empty, Path.Combine)) For Each path As String In paths Process.Start(New ProcessStartInfo With { .FileName = path, .UseShellExecute = True, .Verb = "open" }) Next End Sub Error 1 Overload resolution failed because no accessible 'Select' can be called with these arguments: Extension method 'Public Function Select(Of TResult)(selector As System.Func(Of System.Xml.Linq.XElement, Integer, TResult)) As System.Collections.Generic.IEnumerable(Of TResult)' defined in 'System.Linq.Enumerable': Nested function does not have a signature that is compatible with delegate 'System.Func(Of System.Xml.Linq.XElement, Integer, TResult)'. Extension method 'Public Function Select(Of TResult)(selector As System.Func(Of System.Xml.Linq.XElement, Integer, TResult)) As System.Collections.Generic.IEnumerable(Of TResult)' defined in 'System.Linq.Enumerable': Data type(s) of the type parameter(s) cannot be inferred from these arguments. Specifying the data type(s) explicitly might correct this error. Extension method 'Public Function Select(Of TResult)(selector As System.Func(Of System.Xml.Linq.XElement, TResult)) As System.Collections.Generic.IEnumerable(Of TResult)' defined in 'System.Linq.Enumerable': Data type(s) of the type parameter(s) in extension method 'Public Function Aggregate(Of TAccumulate)(seed As TAccumulate, func As System.Func(Of TAccumulate, String, TAccumulate)) As TAccumulate' defined in 'System.Linq.Enumerable' cannot be inferred from these arguments. Specifying the data type(s) explicitly might correct this error. Extension method 'Public Function Select(Of TResult)(selector As System.Func(Of System.Xml.Linq.XElement, TResult)) As System.Collections.Generic.IEnumerable(Of TResult)' defined in 'System.Linq.Enumerable': Data type(s) of the type parameter(s) cannot be inferred from these arguments. Specifying the data type(s) explicitly might correct this error. Alguém sabe a razão? Obrigado

Elabore um algoritmo que dado um número de três algarismos n=CDU (C é o algarismo das centenas, D das dezenas e U das unidades), retorne um número m constituído pelos algarismos de n em ordem inversa, isto é, m=UDC. Por exemplo, para n=123, m=321. Alguem me pode ajudar a realizar este exercicio ?

Boa Tarde, Eu tenho o seguinte código, onde crio 5 botões através de um ciclo e queria saber como é que consigo programa-los, eu tentei com o AddHandler mas ao tentar correr o programa dá-me os erros "Expression Expected" e "Charapter is not valid" nessa mesma linha de código "AddHandler b.Click, AddressOf HandleDynamicButtonclick". Dim b As New Button For i = 1 To 5 b.Name = "btn" & i b.Text = "btn" & i AddHandler b.Click, AddressOf HandleDynamicButtonclick b.Width = 79 b.Height = 50 MsgBox("ola butão" & i) b.Font = New Font("Perpetua", 12) FlowLayoutPanel1.Controls.Add(b) Next Private Sub HandleDynamicButtonclick(ByVal sender As Object, ByVal e As EventArgs) Dim btn As Button = DirectCast(sender, Button) If btn.Name = "botão1" Then MsgBox("Btn1 clicked") ElseIf btn.Name = "botão2" Then MsgBox("Btn2 Clicked") End If End Sub Podem me ajudar no que falta ou o que esta errado.

Tenho um VBA no Excel, entretanto o comando salva os lançamentos como texto, então não é possível aplicar qualquer fórmula. Já fiz algumas tentativas e pesquisa mas todas foram fracassadas, segue os códigos: Private Sub CommandButton_gravar_Click() Dim valor As Currency Dim data As Date valor = TextBox_valor data = TextBox_data Range("b11").Select If Range("b12").Value <> "" Then Selection.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select Selection.Value = TextBox_data ActiveCell.Offset(0, 1).Select Selection.Value = ComboBox_categoria ActiveCell.Offset(0, 1).Select Selection.Value = TextBox_historico ActiveCell.Offset(0, 1).Select Selection.Value = ComboBox_movimento ActiveCell.Offset(0, 1).Select Selection.Value = TextBox_valor Unload UserForm_lançamento Também tentei fazer um teste após o lançamento para converter em numero mas não funcionou For Each cell In [f1:f50000] If cell > "" Then numero = (cell.Value) cell.Activate ActiveCell.FormulaR1C1 = numero Else End If Next Minha última tentativa em converter o texto foi adicionar a seguinte linha de código Selection.Value = TextBox_valor Selection.NumberFormat = "$#,##0.00"

Boa tarde Sou novo neste forum e agradeço desde já qualquer ajuda que me possam dispensar. Tenho uma planilha (Peninsula 2011) com 43 colunas (A até BK) e com 5905 linhas. O que pretendo é que quando for inserido qualquer valor numerico na celula C todas as celulas a partir daí e na mesma linha fiquem bloqueadas. Por exemplo, ao inserir o valor 5500 na celula C5, bloquear tudo da D5 até à BK5 para evitar futura alteração de dados. Muito obrigado pela atenção.

Boa noite, desde já aviso que percebo muito pouco de visual basic e ando a tentar executar umas macro no excel para facilitar o trabalho. Neste momento tenho uma base de preços numa sheet do excel e criei um formulário com um listbox e duas caixas de texto para realizar procura automática. O problema que tenho, é que a procura apenas de cinge à primeira palavra do campo onde procura, nunca vai procurar a combinação de caracteres ás restantes palavras. Não sei se me fiz entender, mas vou deixar aqui o código para ver se alguém me consegue ajudar. Obrigado desde já. Sub FILTRO() On Error GoTo Erro Dim linha, linhalist As Integer Dim valor_celula As String linhalist = 0 linha = 2 bdcdo.Clear 'ORCABDCDO.Select - Vinha com o código original, mas fazia saltar de folha. With ORCABDCDO While .Cells(linha, 1).Value <> "" valor_celula = .Cells(linha, 1).Value If UCase(Left(valor_celula, Len(codigo.Text))) = UCase(codigo.Text) Then valor_celula = .Cells(linha, 2).Value If UCase(Left(valor_celula, Len(design.Text))) = UCase(design.Text) Then Me.bdcdo.ColumnWidths = "60;200;40;60" With bdcdo .AddItem .List(linhalist, 0) = ORCABDCDO.Cells(linha, 1) .List(linhalist, 1) = ORCABDCDO.Cells(linha, 2) .List(linhalist, 2) = ORCABDCDO.Cells(linha, 3) .List(linhalist, 3) = Format(ORCABDCDO.Cells(linha, 4), "currency") End With linhalist = linhalist + 1 End If End If linha = linha + 1 Wend End With Exit Sub Erro: MsgBox "Erro!", vbCritical, "filtro" End Sub Private Sub codigo_Change() Call FILTRO End Sub Private Sub design_Change() Call FILTRO End Sub Private Sub UserForm_Click() End Sub

Fala pessoal, alguém poderia me ajudar, eu estou com um problema na minha caixa combobox, ela parou de funcionar. e eu também não consigo editar mais o eixo onde fica os valores dos gráficos, sempre que entro em "formatar" meu Excel trava e para de funcionar.

Boa tarde Eu estou com uma tabela, e nessa tabela eu usei a função endereço+corresp para me retornar o endereço referente a uma palavra chave especifica. agora eu preciso de um VBA para me levar a esse endereço que a função me retornou. Por gentileza alguém pode me ajudar?

Boa noite, Estou usando parte do codigo abaixo para enviar e-mails de forma automatica pelo excel, mas quero que o inicial do range que no memento é A6 seja mutavel de acordo com o valor especifico de uma celula, Set IntervaloMailing = WrkS.Range("A6:A7") Por exemplo: Se a celula que eu vou usar como referencia estiver com o valor A5 Esta parte codigo ficaria: Set IntervaloMailing = WrkS.Range("A5:A7") ou seja o primeiro valor do range precisa mudar de acordo com o valor que for digitavel na minha celular de referencia que neste caso poderia ser a primeira celula da planilha Segue o codigo que eu estou usando Public WrkB As Workbook 'Cria variavel da Pasta de Trabalho Public WrkS As Worksheet 'Cria variavel da Planilha Public IntervaloMailing As Range 'Cria Variavel com o Intervalo do Mailing Public Celula As Range 'Cria Variavel com o registro do Mailing Public AppOutk As Outlook.Application 'Cria Variavel com a Aplicacao do Outlook Public MailOutk As Outlook.MailItem 'Cria Variavel com o objeto "Email" do Outlook Public Sub MandarEmail() Set WrkB = ThisWorkbook 'Define a pasta de Trabalho Set WrkS = WrkB.Sheets("Mailing") 'Define a Planilha com os dados Set IntervaloMailing = WrkS.Range("A7:A7") 'Define qual o intervalo do Mailing <<<< esta parte que preciso que seja variavel With WrkS .Select For Each Celula In IntervaloMailing Call CriaEmail 'Chama a Rotina para Criar o Email Next End With End Sub Atenciosamente Nate