Ir ao conteúdo
  • Cadastre-se

Obadia

Membros Plenos
  • Total de itens

    175
  • Registro em

  • Última visita

  • Qualificações

    0%

Reputação

2

Sobre Obadia

  • Data de Nascimento 26-12-1982 (35 anos)

Informações gerais

  • Cidade e Estado
    Rio de Janeiro, RJ
  • Sexo
    Masculino
  1. :(Tenho um código que envia por macro um email, até ai tudo bem, só que eu quero colocar no corpo do email uma figura que está vinculada com os dados de uma tabela (camera do excel), ou seja, ela é atualizada toda vez que eu rodo a macro e envia um email. Já procurei muito pela net e achei vários exemplos, porém todos buscando de lugares como na rede, ou no c:\, mas eu quero uma figura de dentro do excel mesmo! Ahhh segue a macro abaixo: Option Explicit Sub Enviar_email() Dim enderecos As Range Dim celula As Range Dim anexo As String Dim r As Integer Dim fim Dim enviar Dim objOlAppApp As Outlook.Application Dim objOlAppMsg As Outlook.MailItem Dim objOlAppRecip As Outlook.Recipient Set objOlAppApp = CreateObject("Outlook.Application") Set objOlAppMsg = objOlAppApp.CreateItem(olMailItem) 'Celulas com os endereços Set enderecos = Range("C18") With objOlAppMsg .Importance = 2 .To = "destinatário" .CC = "outros destinatário(s)" 'verificar se existe destinatário(s) If .Recipients.Count = 0 Then GoTo fim 'Anexar ficheiro(s), com o nome e caminho escrito na celula C13 'Para mais do que 1 anexo utilizar ; como separador 'Ex: c:\anexo1.txt;c:\anexo2.txt;c:\anexo3.txt anexo = Range("C13") 'testar se existe anexos If Len(anexo) = 0 Then GoTo enviar 'tratar anexos Dim anexos anexos = Split(anexo, ";") Dim i For i = LBound(anexos) To UBound(anexos) 'verificar se o caminho para o anexo é válido If Dir(anexos(i)) = "" Then r = MsgBox("Anexo '" & anexos(i) & "'inexistente ou caminho invalido, " & "pretende enviar assim mesmo ? ", vbYesNo, "Erro na localização do anexo") If r <> vbYes Then GoTo fim Else .Attachments.Add anexos(i) End If Next i enviar: 'O assunto .Subject = "Segue o resultado " & Format(Now, "dd/mm") 'tratar imagens para inserir no email Dim imagem, arrImagens 'celula onde colocamos a localização da imagem imagem = Sheets("imagem").Range("A1") If Len(imagem) > 0 Then arrImagens = Split(imagem, ";") imagem = "<p>Imagem</p>" For i = LBound(arrImagens) To UBound(arrImagens) If Dir(arrImagens(i)) <> "" Then .Attachments.Add arrImagens(i) imagem = "<p><img src=""cid:" & recolheImagem(arrImagens(i)) & """ /></p>" End If Next i End If 'O conteudo do Mail, imagens e assinatura (caso existam) .HTMLBody = "<html>" & "<font color=#3333FF><font face=calibri><font size=2><body>Senhores,<br /><br>" & "Seguem abaixo os resultados de hoje.<br /><br>" & imagem & "<br />" & Assinatura & "</body></html>" 'enviar mensagem .Display End With fim: 'Libertar as variaveis Set objOlAppApp = Nothing Set objOlAppMsg = Nothing Set objOlAppRecip = Nothing End Sub ' Função usada para tratar o pedido de inserção de assinatura Function Assinatura() Dim fAssinatura, stAssinatura, stLinha fAssinatura = Environ("APPDATA") & "\Microsoft\Signatures\" & Range("C15") stAssinatura = "" If Dir(fAssinatura) <> "" Then Open fAssinatura For Input As #1 Do While Not EOF(1) Line Input #1, stLinha stAssinatura = stAssinatura & vbCrLf & stLinha Loop Close #1 End If Assinatura = stAssinatura End Function ' Função que retira o caminho da imagem deixando só o nome desta, ' é usado para inserir a imagem no email. ' Ex: c:\imagens\imagem.jpg ' fica: imagem.jpg Function recolheImagem(stImagem) Dim x, ultimo_x 'vamos buscar só o nome da imagem x = InStr(1, stImagem, "\") Do ultimo_x = x x = InStr(x + 1, stImagem, "\") Loop Until x = 0 recolheImagem = Mid(stImagem, InStr(ultimo_x, stImagem, "\") + 1, Len(stImagem)) End Function Abraços,
  2. Caro amigo jeffsilveira, Realmente deu certo. Muito obrigado pela ajuda. Abs
  3. Eu tentei o código abaixo, mas está gerando um erro 1004. Alguém sabe informar o que escrevi errado? Private Sub CommandButton7_Click() ultima = ThisWorkbook.Sheets("export").Range("a65536").End(xlUp).Row * -1 'para não sobreescrever, joga para a última linha b = (ultima * -1) + 1 With ThisWorkbook.Sheets("export") .Cells(ultima, 1) = ComboBox1.Value ' O erro fica nessa linha! .Cells(ultima, 2) = ComboBox19.Value .Cells(ultima, 3) = TextBox74.Value .Cells(ultima, 4) = TextBox1.Value .Cells(ultima, 5) = TextBox2.Value .Cells(ultima, 6) = TextBox3.Value .Cells(ultima, 7) = TextBox98.Value .Cells(ultima, 8) = ComboBox61.Value .Cells(ultima, 9) = TextBox122.Value End With End Sub
  4. Caro amigo zinhovba, Obrigado pela ajuda, mas os dados ainda sobreescrevem o que já foi gravado com sucesso e eu quero que coloque abaixo! tem como me ajudar também nesse sentido? Abs
  5. Galera, Estou tentando exportar todos os valores de vários textbox para a planilha do excel sem sobreescrever o que já está lá. Como eu consigo fazer isso? Segue um código que eu tentei usar para ajuda no entendimento. Private Sub CommandButton7_Click() ult_linha = ThisWorkbook.Sheets("export").Range("a65536").End( xlUp).Row * -1 b = (ult_linha * -1) + 1 For Each preenchimento In ThisWorkbook.Sheets("export").Range("a" & b & ":i" & If preenchimento.Offset(ult_linha, 0) = "Edição" Then preenchimento.Value = ComboBox1.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Local de Entrega" Then preenchimento.Value = ComboBox19.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Nº de Transporte" Then preenchimento.Value = TextBox74.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Erro" Then preenchimento.Value = TextBox1.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Total Tiragem" Then preenchimento.Value = TextBox2.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Acuracidade" Then preenchimento.Value = TextBox3.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Peso" Then preenchimento.Value = TextBox98.Value ElseIf preenchimento.Offset(ult_linha, 0) = "Total Viagem" Then preenchimento.Value = ComboBox61.Value ElseIf preenchimento.Offset(ult_linha, 0) = "(%)" Then preenchimento.Value = TextBox122.Value End If Next End Sub Abs
  6. Você pode começar a usar a imaginação, como por exemplo um procv da concatenação de uma condição SE. Se der isso faz um procv disso se não faz um procv concatenado com outra célula e por ai vai.
  7. Então o melhor a fazer é um procv, ou um proch conforme eu citei em outro lugar rs. abs
  8. Caro amigo Locunha, Vá até Ferramentas> Opções> Listas e add uma lista. Depois na planilha é só colocar o primeiro e arrastar. Agora se você só quer colocar os zeros na frente, também tem uma outra forma: Formatar as células e em Número > Categoria selecione a opção personalizado. Se você quer sempre 3 zeros na frente, coloque 00000 (3 primeiro são os zeros e os outros dois dígitos são os números. Abs
  9. Caro amigo fcmulazzani, Você teria que declarar uma variável no botão "ok", para não dar erro com o último dado preenchido. Segue um exemplo abaixo: ult_linha = ThisWorkbook.Sheets("plan1").Range("a65536").End(xlUp).Row * -1 b = (ult_linha * -1) + 1 For Each preenchimento In ThisWorkbook.Sheets("plan1").Range("a" & b & ":i" & Abs,
  10. Caro amigo Gilberto, a resposta para a sua dúvida está no link abaixo: http://forum.clubedohardware.com.br/consolidar-informacao-varias/1086757 Muito parecida com o que já perguntaram. Quando for assim utilize a pesquisa do Forum para não perder tempo ou duplicar o tópico. Abs.
  11. Caro amigo mnconceicao, Para você fazer com que essa planilha se torne automática, vai precisar que perca algum tempo fazendo pela primeira vez links. Primeiro: abra todas as planilha que for lincar (se for muitas, abra duas de cada vez); Segundo: Coloque o sinal de = na planilha matriz e depois vá para a outra planilha e clique na célula que você quer que apareça na matriz. Terceiro: Faça isso com as demais células. Pronto, agora ela está vinculada e toda vez que atualizarem as planilha a matriz vai atualizar quando abri-la. Abs,
  12. Caro amigo Vanmaster, Seria melhor postar a planilha no 4shared, ou algo parecido para podermos ajudar melhor!!! Att,
  13. Caro amigo eduzsrj, Você tem que ir em importação de dados e escolher o TXT como delimitado e depois flega em outros e coloca o caracter específico, no seu caso o | . Ok? Era isso mesmo? Att,
  14. Boa tarde Robert, A leitura dessa segunda parte é da fórmula se éerros. Você lê da seguinte forma... faz o procv e se der erro coloca espaço, se não faz a fórmula do procv. Essa fórmula não quer informar se deu erro e sim se não encontrou e ficou com aquele #n/d na célula! Certo. Entendeu? Att,
  15. Caro amigo Robert, Você tem que fechar a fórmula do se éerros. Segu o seu exemplo: =SE(ÉERROS((PROCV(D3;codigo!$A$1:B4705;2;FALSO)));"";(PROCV(D3;codigo!$A$1:B4705;2;FALSO))) Att,

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

×